086e36b08b42edbbb783eb2f5bec5ca4c75d0023
[syinit] / 16-riece-sy.el
1 ;; 16-riece-sy.el --- Riece (IRC) Settings   -*- Emacs-Lisp -*-
2
3 ;; Copyright (C) 2007 - 2013 Steve Youngs
4
5 ;;     Author: Steve Youngs <steve@sxemacs.org>
6 ;; Maintainer: Steve Youngs <steve@sxemacs.org>
7 ;;    Created: <2007-12-02>
8 ;; Time-stamp: <Monday Jun 15, 2015 10:22:22 steve>
9 ;;   Download: <http://bastard.steveyoungs.com/~steve/SXEmacs/inits/>
10 ;;   HTMLised: <http://bastard.steveyoungs.com/~steve/SXEmacs/htmlinits/16-riece-sy.html>
11 ;;   Git Repo: git clone http://git.sxemacs.org/syinit
12 ;;   Keywords: init, compile
13
14 ;; This file is part of SYinit
15
16 ;; Redistribution and use in source and binary forms, with or without
17 ;; modification, are permitted provided that the following conditions
18 ;; are met:
19 ;;
20 ;; 1. Redistributions of source code must retain the above copyright
21 ;;    notice, this list of conditions and the following disclaimer.
22 ;;
23 ;; 2. Redistributions in binary form must reproduce the above copyright
24 ;;    notice, this list of conditions and the following disclaimer in the
25 ;;    documentation and/or other materials provided with the distribution.
26 ;;
27 ;; 3. Neither the name of the author nor the names of any contributors
28 ;;    may be used to endorse or promote products derived from this
29 ;;    software without specific prior written permission.
30 ;;
31 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
32 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
33 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
34 ;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
35 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
36 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
37 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
38 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
39 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
40 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
41 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
42
43 ;;; Commentary:
44 ;;
45 ;;   My Riece settings.
46 ;;
47 ;;   Riece is a very nice IRC client for emacs.  Unlike ERC which
48 ;;   tries to be like "traditional" IRC clients, Riece is much more
49 ;;   emacs like.
50 ;;
51
52 ;;; Credits:
53 ;;
54 ;;   The HTML version of this file was created with Hrvoje Niksic's
55 ;;   htmlize.el which is part of the XEmacs "text-modes" package.
56 ;;
57
58 ;;; Todo:
59 ;;
60 ;;     
61
62 ;;; Code:
63 (require 'riece-options)
64 (require 'riece-biff)
65 (require 'riece-log)
66 (require 'riece)
67
68 ;; Misc setq's
69 (setq riece-alias-percent-hack-mask "*.net"
70       riece-biff-check-channels '("#sxemacs"
71                                   "#emchat"
72                                   "#xemacs")
73       riece-channel-buffer-mode t
74       riece-ctlseq-colors
75             '("white" "black" "blue" "green" "red" "brown"
76               "purple" "orange" "yellow" "lightgreen" "darkcyan"
77               "cyan" "lightblue" "HotPink" "grey35" "grey")
78       riece-default-channel-binding nil
79       riece-default-coding-system 'binary
80       riece-desktop-notify-always t
81       riece-gather-channel-modes t
82       riece-hide-list '(joins parts quits)
83       riece-ignore-discard-message nil
84       riece-keywords
85       '("Bastard" "EMchat" "eMoney" "Gnus" "LFS" "LinuxFromScratch"
86         "Linux From Scratch" "PgSQL" "PostgreSQL" "postgres" "Riece"
87         "SteveYoungs" "SXEmacs" "XEmacs" "systemd" "xwem")
88       riece-layout '"bottom-right"
89       riece-retry-with-new-nickname t
90       riece-server-alist
91       '(("irc.sxemacs.org" :host "irc.sxemacs.org")
92         ("irc.freenode.net" :host "irc.freenode.net")
93         ("irc.au.freenode.net" :host "irc.au.freenode.net")
94         ("irc.nac.net" :host "irc.nac.net")
95         ("irc.efnet.org" :host "irc.efnet.org")
96         ("irc.efnet.net" :host "irc.efnet.net"))
97       riece-user-agent 'emacs-riece-config
98       riece-user-list-buffer-mode t)
99
100 ;; Addons
101 (riece-command-insinuate-addon 'riece-yank)
102 (riece-command-insinuate-addon 'riece-hangman)
103 (riece-command-insinuate-addon 'riece-keepalive)
104 (riece-command-insinuate-addon 'riece-shrink-buffer)
105 (riece-command-insinuate-addon 'riece-xfaceb)
106 (riece-command-insinuate-addon 'riece-button)
107 (riece-command-insinuate-addon 'riece-epg)
108
109 (riece-command-enable-addon 'riece-hangman)
110
111 ;; Leave this OFF it is too annoying.  Fun, but annoying.
112 ;; (riece-command-insinuate-addon 'riece-doctor)
113 ;; (riece-command-enable-addon 'riece-doctor)
114
115 ;; A few handy functions that extend Riece's features a bit.
116 (defvar riece-unread-channels)
117 (defun sy-riece-clear-unread-chans ()
118   "Get rid of the unread mark on all channels."
119   (interactive)
120   (let ((current riece-current-channel))
121     (setq riece-unread-channels nil)
122     (riece-switch-to-channel current)))
123
124 (defun sy-riece-relist-chans-clear-blanks ()
125   "Relist the channel buffer removing any blanks in the sequence.
126
127 When you part from a channel/user you are left with a gap in the
128 sequence of channel numbers in the channels buffer.  This removes
129 those gaps."
130   (interactive)
131   (let ((current riece-current-channel))
132     (setq riece-current-channels
133           (remove-if #'null riece-current-channels))
134     (riece-switch-to-channel current)))
135
136 (defun sy-riece-command-memoserv (command)
137   "Send COMMAND, a string, to MEMOSERV.
138
139 With prefix arg, also /join."
140   (interactive "sMemoserv: ")
141   (when current-prefix-arg
142     (riece-command-join (list ["MemoServ" ""])))
143   (riece-send-string (format "MEMOSERV %s\r\n" command)))
144
145 (defun sy-riece-command-chanserv (command)
146   "Send COMMAND, a string, to CHANSERV.
147
148 With prefix arg, also /join."
149   (interactive "sChanserv: ")
150   (when current-prefix-arg
151     (riece-command-join (list ["ChanServ" ""])))
152   (riece-send-string (format "CHANSERV %s\r\n" command)))
153
154 (defun sy-riece-command-nickserv (command)
155   "Send COMMAND, a string, to NICKSERV.
156
157 With prefix arg, also /join."
158   (interactive "sNickserv: ")
159   (when current-prefix-arg
160     (riece-command-join (list ["NickServ" ""])))
161   (riece-send-string (format "NICKSERV %s\r\n" command)))
162
163 ;; Seems to not exist anymore. :-(
164 (defun sy-riece-command-seenserv (command)
165   "Send COMMAND, a string, to SEENSERV.
166
167 SeenServ doesn't actually exist anymore, so this sends `info nick' to
168 NickServ which gives us the same info.
169
170 With prefix arg, also /join."
171   (interactive "sLast saw who (nick): ")
172   (when current-prefix-arg
173     (riece-command-join (list ["NickServ" ""])))
174   (riece-send-string (format "NICKSERV info %s\r\n" command)))
175
176 (defun sy-riece-command-quick-op ()
177   "Request Ops from ChanServ in the current channel."
178   (interactive)
179   (let ((chan (riece-identity-prefix riece-current-channel)))
180     (sy-riece-command-chanserv (format "OP %s" chan))))
181
182 (defun sy-riece-command-mute-user (&optional user unmute)
183   "Set mode +q on USER, effectively muting them.
184
185 Optional prefix arg, UNMUTE to let them speak again."
186   (interactive "i\nP")
187   (let ((user (or user
188                   (completing-read
189                    "(Un)Mute user: "
190                    (riece-with-server-buffer
191                        (riece-identity-server riece-current-channel)
192                      (riece-channel-get-users (riece-identity-prefix
193                                                riece-current-channel)))))))
194     (riece-send-string 
195      (format "MODE %s %sq %s\r\n"
196              (riece-identity-prefix riece-current-channel)
197              (if (or unmute
198                      current-prefix-arg)
199                  "-"
200                "+")
201              user))))
202
203 (defun sy-riece-list-banned (channel)
204   "List the banned users on CHANNEL, current if omitted."
205   (interactive "P")
206   (let ((channel (if current-prefix-arg
207                      (vector (read-string "Channel: ") "")
208                    riece-current-channel)))
209     (riece-send-string
210      (format "MODE %s b\r\n" (riece-identity-prefix channel)))))
211
212 (defun sy-riece-command-ban-user (&optional user unban)
213   "Ban USER from current channel.
214
215 Optional prefix arg, UNBAN removes the ban."
216   (interactive "i\nP")
217   (let ((user (or user
218                   (completing-read
219                    "(Un)Ban user: "
220                    (riece-with-server-buffer
221                        (riece-identity-server riece-current-channel)
222                      (riece-channel-get-users (riece-identity-prefix
223                                                riece-current-channel))))))
224         reason)
225     (if (or unban
226             current-prefix-arg)
227         (riece-send-string
228          (format "MODE %s -b %s\r\n"
229                  (riece-identity-prefix riece-current-channel)
230                  user))
231       (setq reason (read-string "Reason: " nil nil
232                                 "Need a reason?  Look in a mirror!"))
233       (riece-send-string
234        (format "MODE %s +b %s\r\n"
235                (riece-identity-prefix riece-current-channel)
236                user))
237       (riece-command-kick user reason))))
238
239 ;; Share the muzak!
240 (defun sy-riece-say-now-playing (&optional notice)
241   "Say into the current channel what mp3 is playing.
242
243 With non-nil optional prefix arg, NOTICE, send it as a notice."
244   (interactive "P")
245   (riece-command-send-message
246    (format "NP: %s" (mpd-now-playing)) 
247    (and current-prefix-arg
248         'notice)))
249
250 (defun sy-riece-say-all-purpose (&optional notice)
251   "Send the all-purpose answer to everything."
252   (interactive "P")
253   (riece-command-send-message "Adolf Hitler in fishnets"
254                               (if current-prefix-arg
255                                   'notice
256                                 nil)))
257   
258
259 ;; Tell the world what we're using.
260 (defun sy-riece-say-version (&optional notice)
261   "Say the version of Riece we are running.
262
263 With non-nil prefix arg, NOTICE, send as a notice."
264   (interactive "P")
265   (riece-command-send-message
266    (format "I'm using: %s" (riece-extended-version))
267    (if current-prefix-arg
268        'notice
269      nil)))
270
271 ;; say (foo) => bar
272 (defun sy-riece-send-form ()
273   "Sends a form and it's eval"
274   (interactive)
275   (let* ((form (read-string "sexp: "))
276          (value (eval (read form))))
277     (riece-command-send-message (format "%s => %s" form value)
278                                 (if current-prefix-arg
279                                     'notice
280                                   nil))))
281
282 (defun sy-make-rot13-translation-table ()
283   "Create a rot13 table."
284   (let ((i -1)
285         (table (make-string 256 0))
286         (a (char-to-int ?a))
287         (A (char-to-int ?A)))
288     (while (< (incf i) 256)
289       (aset table i i))
290     (concat
291      (substring table 0 A)
292      (substring table (+ A 13) (+ A 13 (- 26 13)))
293      (substring table A (+ A 13))
294      (substring table (+ A 26) a)
295      (substring table (+ a 13) (+ a 13 (- 26 13)))
296      (substring table a (+ a 13))
297      (substring table (+ a 26) 255))))
298
299 (defun sy-rot13-string (string)
300   "Convert TEXT to rot13-ese."
301   (let ((table (sy-make-rot13-translation-table)))
302     (with-temp-buffer
303       (insert string)
304       (translate-region (point-min) (point-max) table)
305       (buffer-string))))
306
307 (defun sy-riece-send-rot13 (text)
308   "Talk in rot13-ese."
309   (interactive "srot13: ")
310   (riece-command-send-message
311    (sy-rot13-string text)
312    (if current-prefix-arg
313        'notice
314      nil)))
315
316 (defun sy-morse-string (string)
317   "Return STRING in morse code."
318   (with-temp-buffer
319     (insert string)
320     (morse-region (point-min) (point-max))
321     (goto-char (point-min))
322     (while (re-search-forward "/" nil t)
323       (replace-match " "))
324     (buffer-string)))
325
326 (defun sy-riece-send-morse (text)
327   "Talk in morse code."
328   (interactive "sMorse: ")
329   (riece-command-send-message
330    (sy-morse-string text)
331    (if current-prefix-arg
332        'notice
333      nil)))
334
335 ;; Show off!
336 (autoload 'riece-command-ctcp-action "riece-ctcp" nil t)
337 (defun sy-riece-show-off ()
338   "Brag about how many channels/people we're talking to."
339   (interactive)
340   (sy-riece-relist-chans-clear-blanks)
341   (let* ((channels riece-current-channels)
342          (numchans (length channels))
343          (numppl 0)
344          currchan)
345     (while channels
346       (setq currchan (car channels))
347       (setq numppl (+ numppl
348                       (length (riece-with-server-buffer
349                                   (riece-identity-server currchan)
350                                 (riece-channel-get-users 
351                                  (riece-identity-prefix currchan))))))
352       (setq channels (cdr channels)))
353     (riece-command-ctcp-action
354      riece-current-channel
355      (format
356       "is in %d channels, talking to %d people :-P"
357       numchans numppl))))
358
359 ;; Brag about how long SXEmacs has been up
360 (defun sy-riece-sxe-uptime ()
361   "Display as action SXEmacs uptime."
362   (interactive)
363   (let* ((ut (uptime))
364          (days (car ut))
365          (hours (cadr ut))
366          (minutes (caddr ut))
367          (seconds (cadddr ut)))
368     (riece-command-ctcp-action
369      riece-current-channel
370      (concat "-=[ SXEmacs Uptime: "
371              (unless (zerop days)
372                (if (eq days 1)
373                    "1 day, "
374                  (concat (number-to-string days) " days, ")))
375              (unless (zerop hours)
376                (if (eq hours 1)
377                    "1 hour, "
378                  (concat (number-to-string hours) " hours, ")))
379              (unless (zerop minutes)
380                (if (eq minutes 1)
381                    "1 minute, "
382                  (concat (number-to-string minutes) " minutes, ")))
383              (if (zerop seconds)
384                  "and 0 seconds"
385                (if (eq seconds 1)
386                    "and 1 second."
387                  (concat "and "
388                          (number-to-string seconds)
389                          " seconds")))
390              " ]=-"))))
391       
392
393 ;; segassem desrever eikeeg ylbirreT
394 (defun sy-riece-reverse ()
395   ".sdrawkcab kaepS"
396   (interactive)
397   (let ((str (read-string "Say backwards: ")))
398     (riece-command-send-message
399      (concat (nreverse (string-to-list str))) nil)))
400
401 ;; .oO0{ what's he thinking? }
402 (defun sy-riece-think ()
403   "Send a .oO0{ think balloon action }."
404   (interactive)
405   (let ((think (read-string "What are you thinking? ")))
406     (riece-command-ctcp-action
407      riece-current-channel
408      (format ".oO0{ %s }" think))))
409
410 ;; When pictures speak louder than words...
411 (defun sy-riece-fuck-you (&optional upyours)
412   "For those occasions where... you know what I mean."
413   (interactive "P")
414   (let ((fuckyou "
415      _                         _
416     |_|                       |_|
417     | |         /^^^\\         | |
418    _| |_      (| \"o\" |)      _| |_
419  _| | | | _    (_---_)    _ | | | |_
420 | | | | |' |    _| |_    | `| | | | |
421 |          |   /     \\   |          |
422  \\        /  / /(. .)\\ \\  \\        /
423    \\    /  / /  | . |  \\ \\  \\    /
424      \\  \\/ /    ||Y||    \\ \\/  /
425       \\__/      || ||      \\__/
426                 () ()
427                 || ||
428                ooO Ooo")
429         (upyours "
430     .-.    
431     |U|    
432     | |    
433     | |    
434    _| |_   
435   | | | |-.
436  /|     ` |
437 | |       |
438 |         |
439 \\         /
440  |       | 
441  |       |")
442         (riece-yank-tick 0.1))
443     (with-temp-buffer
444       (if current-prefix-arg 
445           (insert upyours)
446         (insert fuckyou))
447       (kill-region (point-min) (point-max)))
448     (riece-command-yank nil nil)))
449
450 ;; Nick completion.  Lets face it, compared to other IRC clients like
451 ;; BitchX or even ERC, Riece's nick completion is pretty sucky. :-(
452 ;; This is my vain attempt to improve it.
453 (defun sy-riece-command-complete-user ()
454   "Like `riece-command-complete-user' but restrict to current chan.
455
456 This version of nick completion maintains the original case of the
457 nick being completed.  The version in Riece downcases the completion
458 \(could be a bug\).
459
460 If the completion is being inserted at column zero, `: ' is appended,
461 otherwise ` ' is added.
462
463 The following is not yet implemented, but I'd also like to be able to
464 complete from the middle of a nick...
465
466   Nickname     User Types      Expands To
467   --------     ----------      ----------
468   MyNick        nic<TAB>       MyNick:<SPC>"
469   (interactive)
470   (let* ((completion-ignore-case t)
471          (table (riece-with-server-buffer
472                     (riece-identity-server riece-current-channel)
473                   (riece-channel-get-users (riece-identity-prefix
474                                             riece-current-channel))))
475          (current (or (current-word) ""))
476          (completion (try-completion current table))
477          (all (all-completions current table)))
478     (if (eq completion t)
479         nil
480       (if (null completion)
481           (message "Can't find completion for \"%s\"" current)
482         (if (equal current completion)
483             (with-output-to-temp-buffer "*Help*"
484               (display-completion-list all))
485           (re-search-forward "\\>" nil t)
486           (delete-region (point) (- (point) (length current)))
487           (if (eq (point) (point-at-bol))
488               (insert completion ": ")
489             (insert completion " ")))))))
490
491 ;(defalias 'riece-command-complete-user 'sy-riece-command-complete-user)
492
493 ;; "schme" <marcus@sxemacs.org> funky cycling completion
494 ;; Reworked to support cycling in both directions using dllists, plus
495 ;; other misc improvements by me. --SY.
496 (defvar riece-me:completion-time 3
497   "Time in seconds before completion list is reset.")
498 (defvar riece-me:*completion-timer* (make-itimer)
499   "Completion timer.")
500 (defvar riece-me:*completion-list* nil
501   "Completion list.")
502
503 (defvar sy-riece-nick-syntax-table
504   (let ((table (copy-syntax-table text-mode-syntax-table)))
505     (modify-syntax-entry ?~  "w " table)
506     (modify-syntax-entry ?`  "w " table)
507     (modify-syntax-entry ?-  "w " table)
508     (modify-syntax-entry ?_  "w " table)
509     (modify-syntax-entry ?+  "w " table)
510     (modify-syntax-entry ?{  "w " table)
511     (modify-syntax-entry ?[  "w " table)
512     (modify-syntax-entry ?}  "w " table)
513     (modify-syntax-entry ?]  "w " table)
514     (modify-syntax-entry ?\\ "w " table)
515     (modify-syntax-entry ?|  "w " table)
516     (modify-syntax-entry ?:  "w " table)
517     (modify-syntax-entry ?\; "w " table)
518     (modify-syntax-entry ?'  "w " table)
519     (modify-syntax-entry ?<  "w " table)
520     (modify-syntax-entry ?,  "w " table)
521     (modify-syntax-entry ?>  "w " table)
522     table)
523   "Syntax table used in funky nick cycling completion.")
524
525 (defun sy-riece-init-completion-timer ()
526   "Initialise the completion timer."
527   (let ((timer riece-me:*completion-timer*))
528     (set-itimer-function timer #'(lambda ()
529                                    (setq riece-me:*completion-list* nil)))
530     (set-itimer-value timer riece-me:completion-time)))
531 (add-hook 'riece-after-login-hook #'sy-riece-init-completion-timer)
532
533 (defsubst sy-riece-cycle-list (list &optional reverse)
534   "Return a list of head of LIST, and LIST rotated 1 place forward.
535
536 If optional argument, REVERSE is non-nil, rotate the list in the other
537 direction."
538   (let ((list (apply #'dllist list))
539         name)
540     (if reverse
541         (dllist-rrotate list)
542       (dllist-lrotate list))
543     (setq name (dllist-car list))
544     (list name (dllist-to-list list))))
545
546 (defsubst sy-riece-set-completion-timer ()
547   "(Re)set completion timer's value."
548   (let ((timer riece-me:*completion-timer*))
549     (and (itimerp timer)
550          (set-itimer-value timer riece-me:completion-time))))
551
552 (defun sy-riece-complete-user-backwards ()
553   "Complete nick, cycling backwards.
554 See `riece-me:command-complete-user'."
555   (interactive)
556   (riece-me:command-complete-user 'reverse))
557
558 (add-hook 'riece-command-mode-hook
559           #'(lambda ()
560               ;; Define a few keys here so they don't have the `C-c' prefix
561               (local-set-key [iso-left-tab] #'sy-riece-complete-user-backwards)
562               (local-set-key [(super next)] #'riece-command-user-list-scroll-up)
563               (local-set-key [(super prior)] #'riece-command-user-list-scroll-down)
564               (local-set-key [(hyper next)] #'riece-command-scroll-up)
565               (local-set-key [(hyper prior)] #'riece-command-scroll-down)))
566
567 (defun riece-me:command-complete-user (&optional reverse)
568   "Like `riece-command-complete-user' but restrict to current chan.
569
570 This completion does not pop up any completion buffers, instead it
571 cycles through the user names \"in-place\" with each successive TAB.
572
573 With non-nil optional argument, REVERSE, the cycling goes in the other
574 direction.
575
576 If the completion is being inserted at column zero, \": \" is appended,
577 otherwise \" \" is added. "
578   (interactive)
579   (unless riece-me:*completion-list*
580     (unless (itimer-live-p riece-me:*completion-timer*)
581       (sy-riece-set-completion-timer)
582       (activate-itimer riece-me:*completion-timer*))
583     (let* ((completion-ignore-case t)
584            (table (riece-with-server-buffer
585                       (riece-identity-server riece-current-channel)
586                     (riece-channel-get-users (riece-identity-prefix
587                                               riece-current-channel))))
588            (current (current-word))
589            (completion (try-completion current table))
590            (all (all-completions current table)))
591       (if (null completion)
592           (message "Can't find completion for \"%s\"" current)
593         (setq riece-me:*completion-list* all))))
594   (when riece-me:*completion-list*
595     (multiple-value-bind (completion newlist)
596         (sy-riece-cycle-list riece-me:*completion-list* reverse)
597       (setq riece-me:*completion-list* newlist)
598       (with-syntax-table sy-riece-nick-syntax-table
599         (unless (string= "" (current-word))
600           (backward-delete-word))
601         (insert completion)
602         (let ((nicksuffix " "))
603           (save-excursion
604             (backward-word)
605             (and (bolp)
606                  (setq nicksuffix ": ")))
607           (insert nicksuffix)))
608       (sy-riece-set-completion-timer))))
609
610 (defalias 'riece-command-complete-user 'riece-me:command-complete-user)
611 ;;;
612
613 (defun sy-riece-add-rem-biff-channel (&optional remove)
614   "Add the current channel to the list of channels for riece-biff.
615
616 With optional prefix arg, REMOVE, remove the current channel from the
617 biff list."
618   (interactive "P")
619   (if (or current-prefix-arg
620           remove)
621       ;; Remove chan.
622       (progn
623         (setq riece-biff-check-channels
624               (remove (riece-identity-prefix riece-current-channel)
625                       riece-biff-check-channels))
626         (message "Channel: %s removed from riece-biff channel list."
627                  (riece-identity-prefix riece-current-channel)))
628     ;; Add chan.
629     (add-to-list 'riece-biff-check-channels
630                  (riece-identity-prefix riece-current-channel))
631     (message "Channel: %s added to riece-biff channel list."
632              (riece-identity-prefix riece-current-channel))))
633
634 (defun sy-riece-get-sxemacs-topic-version ()
635   "Return the \"version\" section of #sxemacs topic."
636   (let* ((topic (riece-with-server-buffer
637                     (riece-identity-server riece-current-channel)
638                   (riece-channel-get-topic "#sxemacs")))
639          (ver (third (split-string-by-char topic ?\ ))))
640     ver))
641
642 (defun sy-riece-sxemacs-topic-version-update (&optional newver)
643   "*Updates the \"version\" section of #sxemacs topic with NEWVER.
644 With a prefix arg, prompt for the new version string."
645   (interactive "P")
646   (let* ((oldver (sy-riece-get-sxemacs-topic-version))
647          (gitver (substring (shell-command-to-string
648                              "( cd ${SXEWD}; git describe master )")
649                             0 -1))
650          (newver (or (and current-prefix-arg
651                           (read-string "New Version: "
652                                        sxemacs-git-version nil
653                                        sxemacs-git-version))
654                      gitver))
655         (chan (riece-identity-prefix riece-current-channel)))
656     (unless (string= chan "#sxemacs")
657       (error 'invalid-argument "Wrong channel" chan))
658     (riece-command-send-message
659      (format ",topic change 1 s/%s/%s/" oldver newver) nil)))
660
661 ;; Define keys for those functions.
662 (define-key riece-command-map (kbd "C-c C") #'sy-riece-clear-unread-chans)
663 (define-key riece-command-map (kbd "C-c r")
664   #'sy-riece-relist-chans-clear-blanks)
665 (define-key riece-command-map (kbd "C-c m") #'sy-riece-command-mute-user)
666 (define-key riece-command-map (kbd "C-b") #'sy-riece-command-ban-user)
667 (define-key riece-command-map (kbd "C-o") #'sy-riece-command-quick-op)
668 (define-key riece-command-map (kbd "C-c n") #'sy-riece-say-now-playing)
669 (define-key riece-command-map (kbd "C-c V") #'sy-riece-say-version)
670 (define-key riece-command-map (kbd "C-c s") #'sy-riece-show-off)
671 (define-key riece-command-map (kbd "C-c f") #'sy-riece-fuck-you)
672 (define-key riece-command-map (kbd "C-c b") #'sy-riece-add-rem-biff-channel)
673 (define-key riece-command-map (kbd "C-c ?") #'sy-riece-think)
674 (define-key riece-command-map (kbd "C-c R") #'sy-riece-reverse)
675 (define-key riece-command-map (kbd "C-c T") #'sy-riece-sxemacs-topic-version-update)
676 (define-key riece-command-map (kbd "C-c U") #'sy-riece-sxe-uptime)
677 (define-key riece-command-map [a] #'sy-riece-say-all-purpose)
678
679 ;; So I can start Riece in a new frame
680 (defvar riece-frame nil
681   "Frame for Riece.")
682
683 (defun sy-riece (&optional ask)
684   "Run Riece in a new frame.
685
686 With non-nil optional prefix ASK Riece will prompt for a server to
687 connect to."
688   (interactive "P")
689   (let ((riece-server (if current-prefix-arg
690                           nil
691                         "irc.sxemacs.org")))
692     (setq riece-frame (new-frame '((name . "RieceFrame")
693                                    (width . 110))))
694     (select-frame riece-frame)
695     (call-interactively 'riece)
696     (focus-frame riece-frame)))
697
698 (defun sy-riece-exit-hook ()
699   (when (frame-live-p riece-frame)
700     (delete-frame riece-frame))
701   (setq riece-frame nil))
702
703 (add-hook 'riece-exit-hook #'sy-riece-exit-hook)
704
705 ;; riece-startup-channel-list doesn't fit in with the way I do things
706 ;; and the way freenode functions.  It gets called too damned early.
707 ;; What follows is my attempt to make Riece behave better with logging
708 ;; into freenode, registering to nickserv, joining initial channels,
709 ;; and getting ops with chanserv.
710 (defvar sy-riece-startup-channel-list
711   '("#sxemacs"
712     "#emchat"
713     "#xemacs"
714     ;"#emacs"
715     ;"#postgresql"
716     ;"#avahi"
717     "#systemd"
718     ; No kdbus chan "#kdbus"
719     "#zsh"
720     )
721   "List of channels to join after logging in and identifying to nickserv.")
722
723 ;; Set up channel coding systems
724 ;;
725 ;; This is a PITA... turn on utf and can't read iso-8859-1 special
726 ;; chars, turn it off and can't read utf.  Have I mentioned how much I
727 ;; hate this crap? --SY.
728 (mapcar
729  #'(lambda (chan)
730      (if (string-match #r"#\(sxemacs\|emchat\)" chan)
731          (push (cons chan 'iso-8859-1) riece-channel-coding-system-alist)
732        (push (cons chan 'utf-8) riece-channel-coding-system-alist)))
733  sy-riece-startup-channel-list)
734
735 (defun sy-riece-login ()
736   (riece-send-string (format "PRIVMSG NickServ :identify %s\r\n"
737                              (getenv "IRCPASSWD")))
738   (sleep-for 3)
739   (let ((channel-list sy-riece-startup-channel-list)
740         entry identity)
741     (while channel-list
742       (unless (listp (setq entry (car channel-list)))
743         (setq entry (list (car channel-list))))
744       (if (equal (riece-identity-server
745                   (setq identity (riece-parse-identity (car entry))))
746                  riece-server-name)
747           (riece-command-join-channel identity (nth 1 entry)))
748       (setq channel-list (cdr channel-list))))
749   (riece-send-string "PRIVMSG ChanServ :op #sxemacs\r\n")
750   (riece-send-string "PRIVMSG ChanServ :op #emchat\r\n")
751   (riece-send-string "PRIVMSG ChanServ :op #xemacs\r\n")
752   (riece-send-string
753    (format "PRIVMSG SXEbot :identify SteveYoungs %s\r\n"
754            (getenv "BOTPASSWD"))))
755
756 (add-hook 'riece-after-login-hook #'sy-riece-login)
757
758 ;; Until I can find a solution to my hook problem (login hook not
759 ;; running to completion) I use this to finish the job
760 (defun sy-riece-cleanup-login ()
761   (interactive)
762   (let ((metachans
763          #r".*\.freenode\.net\|\(Chan\|Nick\|Memo\|Seen\)Serv\|SXEbot"))
764     (mapcar
765      #'(lambda (chan-vect)
766          (mapcar
767           #'(lambda (chan)
768               (and (string-match metachans chan)
769                    (riece-part-channel chan-vect)))
770           chan-vect))
771      riece-current-channels)
772     (sy-riece-relist-chans-clear-blanks)
773     (riece-command-switch-to-channel-by-number 1)))
774
775 ;; CANNOT get this to work from the hook.  I suspect it is a
776 ;; networking/async/timing thing.  I have it bound to a key
777 ;; seq... `C-c C-c l', a PITA though.
778 ;(add-hook 'riece-after-login-hook #'sy-riece-cleanup-login 'append)
779 (define-key riece-command-map (kbd "C-c l") 'sy-riece-cleanup-login)
780
781 ;; Automatically clear Riece Biff indicator by switching to the right
782 ;; window/frame
783 (defun sy-riece-check-command-buffer ()
784   (and (get-buffer-window (or riece-command-buffer "*Command*"))
785        (riece-biff-clear)))
786
787 (defadvice switch-to-buffer (after riece-update (&rest args) activate)
788   "After switching buffers, check to see if riece-biff should be cleared.
789 The riece-biff modeline indicator will only be cleared if
790 `riece-command-buffer' is visible in the selected frame."
791   (sy-riece-check-command-buffer))
792
793 (add-hook 'select-frame-hook #'sy-riece-check-command-buffer)
794
795 ;; Easier switch to Riece when running on TTY.
796 (defun sy-switch-to-riece ()
797   "I use this to switch to Riece when I'm on a tty."
798   (interactive)
799   (when (buffer-live-p riece-command-buffer)
800     (pop-to-buffer riece-command-buffer)
801     (riece-command-configure-windows)))
802
803 (define-key global-tty-map [(control ?c) ?r] #'sy-switch-to-riece)
804
805 ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
806 (message "Riece settings loaded successfully")
807