cgit.sxemacs.org Git - syinit/blob - 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