Loads and loads of misc updates
[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 Aug 19, 2013 17:32:20 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                                   ;"#harmattan"
72                                   ;"#meego"
73                                   ;"#n9"
74                                   "#emchat"
75                                   ;"#xwem"
76                                   ;"#fresse"
77                                   "#xemacs")
78       riece-channel-buffer-mode t
79       riece-default-channel-binding nil
80       riece-default-coding-system 'binary
81       riece-gather-channel-modes t
82       riece-ignore-discard-message nil
83       riece-keywords '("JackaLX" "jackalx" "Eicq" "eicq" "EMchat" "emchat"
84                        "SXEmacs" "sxemacs" "XWEM" "xwem" "XLIB" "xlib" "tla"
85                        "arch" "xtla" "XEtla" "xetla" "eMoney" "emoney"
86                        "JackaLX_N9" "jackalx_n9")
87       riece-layout '"bottom-right"
88       riece-retry-with-new-nickname t
89       riece-server-alist
90       '(("irc.sxemacs.org" :host "irc.sxemacs.org")
91         ("irc.au.freenode.net" :host "irc.au.freenode.net")
92         ("azimov.freenode.net" :host "azimov.freenode.net")
93         ("brin.freenode.net" :host "brin.freenode.net")
94         ("irc.freenode.org" :host "irc.freenode.org")
95         ("irc.freenode.net" :host "irc.freenode.net")
96         ("kornbluth.freenode.net" :host "kornbluth.freenode.net")
97         ("orwell.freenode.net" :host "orwell.freenode.net")
98         ("calvino.freenode.net" :host "calvino.freenode.net")
99         ("wells.freenode.net" :host "wells.freenode.net")
100         ("zelazny.freenode.net" :host "zelazny.freenode.net")
101         ("anthony.freenode.net" :host "anthony.freenode.net")
102         ("irc.nac.net" :host "irc.nac.net")
103         ("irc.efnet.org" :host "irc.efnet.org")
104         ("irc.efnet.net" :host "irc.efnet.net"))
105       riece-user-agent 'emacs-riece-config
106       riece-user-list-buffer-mode t)
107
108 ;; Addons
109 (riece-command-insinuate-addon 'riece-yank)
110 (riece-command-insinuate-addon 'riece-hangman)
111 (riece-command-insinuate-addon 'riece-keepalive)
112 (riece-command-insinuate-addon 'riece-shrink-buffer)
113 (riece-command-insinuate-addon 'riece-xfaceb)
114 (riece-command-insinuate-addon 'riece-button)
115 (riece-command-insinuate-addon 'riece-epg)
116
117 (riece-command-enable-addon 'riece-hangman)
118
119 ;; Leave this OFF it is too annoying.  Fun, but annoying.
120 ;; (riece-command-insinuate-addon 'riece-doctor)
121 ;; (riece-command-enable-addon 'riece-doctor)
122
123 ;; A few handy functions that extend Riece's features a bit.
124 (defvar riece-unread-channels)
125 (defun sy-riece-clear-unread-chans ()
126   "Get rid of the unread mark on all channels."
127   (interactive)
128   (let ((current riece-current-channel))
129     (setq riece-unread-channels nil)
130     (riece-switch-to-channel current)))
131
132 (defun sy-riece-relist-chans-clear-blanks ()
133   "Relist the channel buffer removing any blanks in the sequence.
134
135 When you part from a channel/user you are left with a gap in the
136 sequence of channel numbers in the channels buffer.  This removes
137 those gaps."
138   (interactive)
139   (let ((current riece-current-channel))
140     (setq riece-current-channels
141           (remove-if #'null riece-current-channels))
142     (riece-switch-to-channel current)))
143
144 (defun sy-riece-command-memoserv (command)
145   "Send COMMAND, a string, to MEMOSERV.
146
147 With prefix arg, also /join."
148   (interactive "sMemoserv: ")
149   (when current-prefix-arg
150     (riece-command-join ["MemoServ" ""]))
151   (riece-send-string (format "MEMOSERV %s\r\n" command)))
152
153 (defun sy-riece-command-chanserv (command)
154   "Send COMMAND, a string, to CHANSERV.
155
156 With prefix arg, also /join."
157   (interactive "sChanserv: ")
158   (when current-prefix-arg
159     (riece-command-join ["ChanServ" ""]))
160   (riece-send-string (format "CHANSERV %s\r\n" command)))
161
162 (defun sy-riece-command-nickserv (command)
163   "Send COMMAND, a string, to NICKSERV.
164
165 With prefix arg, also /join."
166   (interactive "sNickserv: ")
167   (when current-prefix-arg
168     (riece-command-join ["NickServ" ""]))
169   (riece-send-string (format "NICKSERV %s\r\n" command)))
170
171 (defun sy-riece-command-seenserv (command)
172   "Send COMMAND, a string, to SEENSERV.
173
174 With prefix arg, also /join."
175   (interactive "sSeenserv: ")
176   (when current-prefix-arg
177     (riece-command-join ["SeenServ" ""]))
178   (riece-send-string (format "SEENSERV %s\r\n" command)))
179
180 (defun sy-riece-command-quick-op ()
181   "Request Ops from ChanServ in the current channel."
182   (interactive)
183   (let ((chan (riece-identity-prefix riece-current-channel)))
184     (sy-riece-command-chanserv (format "OP %s" chan))))
185
186 (defun sy-riece-command-mute-user (&optional user unmute)
187   "Set mode +q on USER, effectively muting them.
188
189 Optional prefix arg, UNMUTE to let them speak again."
190   (interactive "i\nP")
191   (let ((user (or user
192                   (completing-read
193                    "(Un)Mute user: "
194                    (riece-with-server-buffer
195                        (riece-identity-server riece-current-channel)
196                      (riece-channel-get-users (riece-identity-prefix
197                                                riece-current-channel)))))))
198     (riece-send-string 
199      (format "MODE %s %sq %s\r\n"
200              (riece-identity-prefix riece-current-channel)
201              (if (or unmute
202                      current-prefix-arg)
203                  "-"
204                "+")
205              user))))
206
207 (defun sy-riece-list-banned (channel)
208   "List the banned users on CHANNEL, current if omitted."
209   (interactive "P")
210   (let ((channel (if current-prefix-arg
211                      (vector (read-string "Channel: ") "")
212                    riece-current-channel)))
213     (riece-send-string
214      (format "MODE %s b\r\n" (riece-identity-prefix channel)))))
215
216 (defun sy-riece-command-ban-user (&optional user unban)
217   "Ban USER from current channel.
218
219 Optional prefix arg, UNBAN removes the ban."
220   (interactive "i\nP")
221   (let ((user (or user
222                   (completing-read
223                    "(Un)Ban user: "
224                    (riece-with-server-buffer
225                        (riece-identity-server riece-current-channel)
226                      (riece-channel-get-users (riece-identity-prefix
227                                                riece-current-channel))))))
228         reason)
229     (if (or unban
230             current-prefix-arg)
231         (riece-send-string
232          (format "MODE %s -b %s\r\n"
233                  (riece-identity-prefix riece-current-channel)
234                  user))
235       (setq reason (read-string "Reason: " nil nil
236                                 "Need a reason?  Look in a mirror!"))
237       (riece-send-string
238        (format "MODE %s +b %s\r\n"
239                (riece-identity-prefix riece-current-channel)
240                user))
241       (riece-command-kick user reason))))
242
243 ;; Share the muzak!
244 (defun sy-riece-say-now-playing (&optional notice)
245   "Say into the current channel what mp3 is playing.
246
247 With non-nil optional prefix arg, NOTICE, send it as a notice."
248   (interactive "P")
249   (riece-command-send-message
250    (format "NP: %s" (mpd-now-playing)) 
251    (and current-prefix-arg
252         'notice)))
253
254 (defun sy-riece-say-all-purpose (&optional notice)
255   "Send the all-purpose answer to everything."
256   (interactive "P")
257   (riece-command-send-message "Adolf Hitler in fishnets"
258                               (if current-prefix-arg
259                                   'notice
260                                 nil)))
261   
262
263 ;; Tell the world what we're using.
264 (defun sy-riece-say-version (&optional notice)
265   "Say the version of Riece we are running.
266
267 With non-nil prefix arg, NOTICE, send as a notice."
268   (interactive "P")
269   (riece-command-send-message
270    (format "I'm using: %s" (riece-extended-version))
271    (if current-prefix-arg
272        'notice
273      nil)))
274
275 ;; say (foo) => bar
276 (defun sy-riece-send-form ()
277   "Sends a form and it's eval"
278   (interactive)
279   (let* ((form (read-string "sexp: "))
280          (value (eval (read form))))
281     (riece-command-send-message (format "%s => %s" form value)
282                                 (if current-prefix-arg
283                                     'notice
284                                   nil))))
285
286 (defun sy-make-rot13-translation-table ()
287   "Create a rot13 table."
288   (let ((i -1)
289         (table (make-string 256 0))
290         (a (char-to-int ?a))
291         (A (char-to-int ?A)))
292     (while (< (incf i) 256)
293       (aset table i i))
294     (concat
295      (substring table 0 A)
296      (substring table (+ A 13) (+ A 13 (- 26 13)))
297      (substring table A (+ A 13))
298      (substring table (+ A 26) a)
299      (substring table (+ a 13) (+ a 13 (- 26 13)))
300      (substring table a (+ a 13))
301      (substring table (+ a 26) 255))))
302
303 (defun sy-rot13-string (string)
304   "Convert TEXT to rot13-ese."
305   (let ((table (sy-make-rot13-translation-table)))
306     (with-temp-buffer
307       (insert string)
308       (translate-region (point-min) (point-max) table)
309       (buffer-string))))
310
311 (defun sy-riece-send-rot13 (text)
312   "Talk in rot13-ese."
313   (interactive "srot13: ")
314   (riece-command-send-message
315    (sy-rot13-string text)
316    (if current-prefix-arg
317        'notice
318      nil)))
319
320 (defun sy-morse-string (string)
321   "Return STRING in morse code."
322   (with-temp-buffer
323     (insert string)
324     (morse-region (point-min) (point-max))
325     (goto-char (point-min))
326     (while (re-search-forward "/" nil t)
327       (replace-match " "))
328     (buffer-string)))
329
330 (defun sy-riece-send-morse (text)
331   "Talk in morse code."
332   (interactive "sMorse: ")
333   (riece-command-send-message
334    (sy-morse-string text)
335    (if current-prefix-arg
336        'notice
337      nil)))
338
339 ;; Show off!
340 (autoload 'riece-command-ctcp-action "riece-ctcp" nil t)
341 (defun sy-riece-show-off ()
342   "Brag about how many channels/people we're talking to."
343   (interactive)
344   (sy-riece-relist-chans-clear-blanks)
345   (let* ((channels riece-current-channels)
346          (numchans (length channels))
347          (numppl 0)
348          currchan)
349     (while channels
350       (setq currchan (car channels))
351       (setq numppl (+ numppl
352                       (length (riece-with-server-buffer
353                                   (riece-identity-server currchan)
354                                 (riece-channel-get-users 
355                                  (riece-identity-prefix currchan))))))
356       (setq channels (cdr channels)))
357     (riece-command-ctcp-action
358      riece-current-channel
359      (format
360       "is in %d channels, talking to %d people :-P"
361       numchans numppl))))
362
363 ;; Brag about how long SXEmacs has been up
364 (defun sy-riece-sxe-uptime ()
365   "Display as action SXEmacs uptime."
366   (interactive)
367   (let* ((ut (uptime))
368          (days (car ut))
369          (hours (cadr ut))
370          (minutes (caddr ut))
371          (seconds (cadddr ut)))
372     (riece-command-ctcp-action
373      riece-current-channel
374      (concat "-=[ SXEmacs Uptime: "
375              (unless (zerop days)
376                (if (eq days 1)
377                    "1 day, "
378                  (concat (number-to-string days) " days, ")))
379              (unless (zerop hours)
380                (if (eq hours 1)
381                    "1 hour, "
382                  (concat (number-to-string hours) " hours, ")))
383              (unless (zerop minutes)
384                (if (eq minutes 1)
385                    "1 minute, "
386                  (concat (number-to-string minutes) " minutes, ")))
387              (if (zerop seconds)
388                  "and 0 seconds"
389                (if (eq seconds 1)
390                    "and 1 second."
391                  (concat "and "
392                          (number-to-string seconds)
393                          " seconds")))
394              " ]=-"))))
395       
396
397 ;; segassem desrever eikeeg ylbirreT
398 (defun sy-riece-reverse ()
399   ".sdrawkcab kaepS"
400   (interactive)
401   (let ((str (read-string "Say backwards: ")))
402     (riece-command-send-message
403      (concat (nreverse (string-to-list str))) nil)))
404
405 ;; .oO0{ what's he thinking? }
406 (defun sy-riece-think ()
407   "Send a .oO0{ think balloon action }."
408   (interactive)
409   (let ((think (read-string "What are you thinking? ")))
410     (riece-command-ctcp-action
411      riece-current-channel
412      (format ".oO0{ %s }" think))))
413
414 ;; When pictures speak louder than words...
415 (defun sy-riece-fuck-you (&optional upyours)
416   "For those occasions where... you know what I mean."
417   (interactive "P")
418   (let ((fuckyou "
419      _                         _
420     |_|                       |_|
421     | |         /^^^\\         | |
422    _| |_      (| \"o\" |)      _| |_
423  _| | | | _    (_---_)    _ | | | |_
424 | | | | |' |    _| |_    | `| | | | |
425 |          |   /     \\   |          |
426  \\        /  / /(. .)\\ \\  \\        /
427    \\    /  / /  | . |  \\ \\  \\    /
428      \\  \\/ /    ||Y||    \\ \\/  /
429       \\__/      || ||      \\__/
430                 () ()
431                 || ||
432                ooO Ooo")
433         (upyours "
434     .-.    
435     |U|    
436     | |    
437     | |    
438    _| |_   
439   | | | |-.
440  /|     ` |
441 | |       |
442 |         |
443 \\         /
444  |       | 
445  |       |")
446         (riece-yank-tick 0.1))
447     (with-temp-buffer
448       (if current-prefix-arg 
449           (insert upyours)
450         (insert fuckyou))
451       (kill-region (point-min) (point-max)))
452     (riece-command-yank nil nil)))
453
454 ;; Nick completion.  Lets face it, compared to other IRC clients like
455 ;; BitchX or even ERC, Riece's nick completion is pretty sucky. :-(
456 ;; This is my vain attempt to improve it.
457 (defun sy-riece-command-complete-user ()
458   "Like `riece-command-complete-user' but restrict to current chan.
459
460 This version of nick completion maintains the original case of the
461 nick being completed.  The version in Riece downcases the completion
462 \(could be a bug\).
463
464 If the completion is being inserted at column zero, `: ' is appended,
465 otherwise ` ' is added.
466
467 The following is not yet implemented, but I'd also like to be able to
468 complete from the middle of a nick...
469
470   Nickname     User Types      Expands To
471   --------     ----------      ----------
472   MyNick        nic<TAB>       MyNick:<SPC>"
473   (interactive)
474   (let* ((completion-ignore-case t)
475          (table (riece-with-server-buffer
476                     (riece-identity-server riece-current-channel)
477                   (riece-channel-get-users (riece-identity-prefix
478                                             riece-current-channel))))
479          (current (or (current-word) ""))
480          (completion (try-completion current table))
481          (all (all-completions current table)))
482     (if (eq completion t)
483         nil
484       (if (null completion)
485           (message "Can't find completion for \"%s\"" current)
486         (if (equal current completion)
487             (with-output-to-temp-buffer "*Help*"
488               (display-completion-list all))
489           (re-search-forward "\\>" nil t)
490           (delete-region (point) (- (point) (length current)))
491           (if (eq (point) (point-at-bol))
492               (insert completion ": ")
493             (insert completion " ")))))))
494
495 ;(defalias 'riece-command-complete-user 'sy-riece-command-complete-user)
496
497 ;; "schme" <marcus@sxemacs.org> funky cycling completion
498 ;; Reworked to support cycling in both directions using dllists, plus
499 ;; other misc improvements by me. --SY.
500 (defvar riece-me:completion-time 3
501   "Time in seconds before completion list is reset.")
502 (defvar riece-me:*completion-timer* (make-itimer)
503   "Completion timer.")
504 (defvar riece-me:*completion-list* nil
505   "Completion list.")
506
507 (defvar sy-riece-nick-syntax-table
508   (let ((table (copy-syntax-table text-mode-syntax-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     (modify-syntax-entry ?'  "w " table)
523     (modify-syntax-entry ?<  "w " table)
524     (modify-syntax-entry ?,  "w " table)
525     (modify-syntax-entry ?>  "w " table)
526     table)
527   "Syntax table used in funky nick cycling completion.")
528
529 (defun sy-riece-init-completion-timer ()
530   "Initialise the completion timer."
531   (let ((timer riece-me:*completion-timer*))
532     (set-itimer-function timer #'(lambda ()
533                                    (setq riece-me:*completion-list* nil)))
534     (set-itimer-value timer riece-me:completion-time)))
535 (add-hook 'riece-after-login-hook #'sy-riece-init-completion-timer)
536
537 (defsubst sy-riece-cycle-list (list &optional reverse)
538   "Return a list of head of LIST, and LIST rotated 1 place forward.
539
540 If optional argument, REVERSE is non-nil, rotate the list in the other
541 direction."
542   (let ((list (apply #'dllist list))
543         name)
544     (if reverse
545         (dllist-rrotate list)
546       (dllist-lrotate list))
547     (setq name (dllist-car list))
548     (list name (dllist-to-list list))))
549
550 (defsubst sy-riece-set-completion-timer ()
551   "(Re)set completion timer's value."
552   (let ((timer riece-me:*completion-timer*))
553     (and (itimerp timer)
554          (set-itimer-value timer riece-me:completion-time))))
555
556 (defun sy-riece-complete-user-backwards ()
557   "Complete nick, cycling backwards.
558 See `riece-me:command-complete-user'."
559   (interactive)
560   (riece-me:command-complete-user 'reverse))
561
562 (add-hook 'riece-command-mode-hook
563           #'(lambda ()
564               (local-set-key [iso-left-tab] #'sy-riece-complete-user-backwards)))
565
566 (defun riece-me:command-complete-user (&optional reverse)
567   "Like `riece-command-complete-user' but restrict to current chan.
568
569 This completion does not pop up any completion buffers, instead it
570 cycles through the user names \"in-place\" with each successive TAB.
571
572 With non-nil optional argument, REVERSE, the cycling goes in the other
573 direction.
574
575 If the completion is being inserted at column zero, \": \" is appended,
576 otherwise \" \" is added. "
577   (interactive)
578   (unless riece-me:*completion-list*
579     (unless (itimer-live-p riece-me:*completion-timer*)
580       (sy-riece-set-completion-timer)
581       (activate-itimer riece-me:*completion-timer*))
582     (let* ((completion-ignore-case t)
583            (table (riece-with-server-buffer
584                       (riece-identity-server riece-current-channel)
585                     (riece-channel-get-users (riece-identity-prefix
586                                               riece-current-channel))))
587            (current (current-word))
588            (completion (try-completion current table))
589            (all (all-completions current table)))
590       (if (null completion)
591           (message "Can't find completion for \"%s\"" current)
592         (setq riece-me:*completion-list* all))))
593   (when riece-me:*completion-list*
594     (multiple-value-bind (completion newlist)
595         (sy-riece-cycle-list riece-me:*completion-list* reverse)
596       (setq riece-me:*completion-list* newlist)
597       (with-syntax-table sy-riece-nick-syntax-table
598         (unless (string= "" (current-word))
599           (backward-delete-word))
600         (insert completion)
601         (let ((nicksuffix " "))
602           (save-excursion
603             (backward-word)
604             (and (bolp)
605                  (setq nicksuffix ": ")))
606           (insert nicksuffix)))
607       (sy-riece-set-completion-timer))))
608
609 (defalias 'riece-command-complete-user 'riece-me:command-complete-user)
610 ;;;
611
612 (defun sy-riece-add-rem-biff-channel (&optional remove)
613   "Add the current channel to the list of channels for riece-biff.
614
615 With optional prefix arg, REMOVE, remove the current channel from the
616 biff list."
617   (interactive "P")
618   (if (or current-prefix-arg
619           remove)
620       ;; Remove chan.
621       (progn
622         (setq riece-biff-check-channels
623               (remove (riece-identity-prefix riece-current-channel)
624                       riece-biff-check-channels))
625         (message "Channel: %s removed from riece-biff channel list."
626                  (riece-identity-prefix riece-current-channel)))
627     ;; Add chan.
628     (add-to-list 'riece-biff-check-channels
629                  (riece-identity-prefix riece-current-channel))
630     (message "Channel: %s added to riece-biff channel list."
631              (riece-identity-prefix riece-current-channel))))
632
633
634 ;; Define keys for those functions.
635 (define-key riece-command-map (kbd "C-c C") #'sy-riece-clear-unread-chans)
636 (define-key riece-command-map (kbd "C-c r")
637   #'sy-riece-relist-chans-clear-blanks)
638 (define-key riece-command-map (kbd "C-c m") #'sy-riece-command-mute-user)
639 (define-key riece-command-map (kbd "C-b") #'sy-riece-command-ban-user)
640 (define-key riece-command-map (kbd "C-o") #'sy-riece-command-quick-op)
641 (define-key riece-command-map (kbd "C-c n") #'sy-riece-say-now-playing)
642 (define-key riece-command-map (kbd "C-c V") #'sy-riece-say-version)
643 (define-key riece-command-map (kbd "C-c s") #'sy-riece-show-off)
644 (define-key riece-command-map (kbd "C-c f") #'sy-riece-fuck-you)
645 (define-key riece-command-map (kbd "C-c b") #'sy-riece-add-rem-biff-channel)
646 (define-key riece-command-map (kbd "C-c ?") #'sy-riece-think)
647 (define-key riece-command-map (kbd "C-c R") #'sy-riece-reverse)
648 (define-key riece-command-map (kbd "C-c U") #'sy-riece-sxe-uptime)
649 (define-key riece-command-map [a] #'sy-riece-say-all-purpose)
650
651 ;; So I can start Riece in a new frame
652 (defvar riece-frame nil
653   "Frame for Riece.")
654
655 (defun sy-riece (&optional ask)
656   "Run Riece in a new frame.
657
658 With non-nil optional prefix ASK Riece will prompt for a server to
659 connect to."
660   (interactive "P")
661   (let ((riece-server (if current-prefix-arg
662                           nil
663                         "irc.sxemacs.org")))
664     (setq riece-frame (new-frame '((name . "RieceFrame")
665                                    (width . 110))))
666     (select-frame riece-frame)
667     (call-interactively 'riece)
668     (focus-frame riece-frame)))
669
670 (defun sy-riece-exit-hook ()
671   (when (frame-live-p riece-frame)
672     (delete-frame riece-frame))
673   (setq riece-frame nil))
674
675 (add-hook 'riece-exit-hook #'sy-riece-exit-hook)
676
677 ;; riece-startup-channel-list doesn't fit in with the way I do things
678 ;; and the way freenode functions.  It gets called too damned early.
679 ;; What follows is my attempt to make Riece behave better with logging
680 ;; into freenode, registering to nickserv, joining initial channels,
681 ;; and getting ops with chanserv.
682 (defvar sy-riece-startup-channel-list
683   '("#sxemacs"
684     "#emchat"
685     ;"#xwem"
686     ;"#fresse"
687     ;"#xemacs"
688     ;"#emacs"
689     "#harmattan"
690     "#meego"
691     "#n9"
692     ;"#e"
693     ;"#pulseaudio"
694     ;"#latex"
695     ;"#iptables"
696     ;"#netfilter"
697     ;"#postgresql"
698     ;"##c"
699     ;"##kernel"
700     ;"#linux-kernel"
701     ;"#glibc"
702     ;"#gcc"
703     ;"#zsh"
704     )
705   "List of channels to join after logging in and identifying to nickserv.")
706
707 ;; Set up channel coding systems
708 ;;
709 ;; This is a PITA... turn on utf and can't read iso-8859-1 special
710 ;; chars, turn it off and can't read utf.  Have I mentioned how much I
711 ;; hate this crap? --SY.
712 (mapcar
713  #'(lambda (chan)
714      (if (string-match #r"#\(sxemacs\|e\(mchat\|icq\)\|xwem\|fresse\)" chan)
715          (push (cons chan 'iso-8859-1) riece-channel-coding-system-alist)
716        (push (cons chan 'utf-8) riece-channel-coding-system-alist)))
717  sy-riece-startup-channel-list)
718
719 (defun sy-riece-login ()
720   (riece-send-string (format "PRIVMSG NickServ :identify %s\r\n"
721                              (getenv "IRCPASSWD")))
722   (sleep-for 3)
723   (let ((channel-list sy-riece-startup-channel-list)
724         entry identity)
725     (while channel-list
726       (unless (listp (setq entry (car channel-list)))
727         (setq entry (list (car channel-list))))
728       (if (equal (riece-identity-server
729                   (setq identity (riece-parse-identity (car entry))))
730                  riece-server-name)
731           (riece-command-join-channel identity (nth 1 entry)))
732       (setq channel-list (cdr channel-list))))
733   (riece-send-string "PRIVMSG ChanServ :op #sxemacs\r\n")
734   (riece-send-string "PRIVMSG ChanServ :op #emchat\r\n"))
735   ;(riece-send-string "PRIVMSG ChanServ :op #xwem\r\n")
736   ;(riece-send-string "PRIVMSG ChanServ :op #fresse\r\n")
737   ;(riece-send-string "PRIVMSG ChanServ :op #xemacs\r\n"))
738
739 (add-hook 'riece-after-login-hook #'sy-riece-login)
740
741 ;; Until I can find a solution to my hook problem (login hook not
742 ;; running to completion) I use this to finish the job
743 (defun sy-riece-cleanup-login ()
744   (interactive)
745   (riece-command-switch-to-channel-by-number 2)
746   (riece-part-channel riece-current-channel)
747   ;(riece-part-channel ["MemoServ" ""])
748   (riece-part-channel ["ChanServ" ""])
749   (riece-part-channel ["NickServ" ""])
750   (sy-riece-relist-chans-clear-blanks)
751   (riece-command-switch-to-channel-by-number 1))
752
753 ;(add-hook 'riece-after-login-hook #'sy-riece-cleanup-login 'append)
754
755 (define-key riece-command-map (kbd "C-c l") 'sy-riece-cleanup-login)
756
757 ;; Automatically clear Riece Biff indicator by switching to the right
758 ;; window/frame
759 (defun sy-riece-check-command-buffer ()
760   (and (get-buffer-window (or riece-command-buffer "*Command*"))
761        (riece-biff-clear)))
762
763 (defadvice switch-to-buffer (after riece-update (&rest args) activate)
764   "After switching buffers, check to see if riece-biff should be cleared.
765 The riece-biff modeline indicator will only be cleared if
766 `riece-command-buffer' is visible in the selected frame."
767   (sy-riece-check-command-buffer))
768
769 (add-hook 'select-frame-hook #'sy-riece-check-command-buffer)
770
771 ;; Easier switch to Riece when running on TTY.
772 (defun sy-switch-to-riece ()
773   "I use this to switch to Riece when I'm on a tty."
774   (interactive)
775   (when (buffer-live-p riece-command-buffer)
776     (pop-to-buffer riece-command-buffer)
777     (riece-command-configure-windows)))
778
779 (define-key global-tty-map [(control ?c) ?r] #'sy-switch-to-riece)
780
781 ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
782 (message "Riece settings loaded successfully")
783