;; 16-riece.el --- Riece (IRC) Settings

;; Copyright (C) 2007 - 2020 Steve Youngs

;;     Author: Steve Youngs <steve@sxemacs.org>
;; Maintainer: Steve Youngs <steve@sxemacs.org>
;;    Created: <2007-12-02>
;; Time-stamp: <Thursday Apr  9, 2020 19:11:39 steve>
;;   Download: <https://downloads.sxemacs.org/SYinits>
;;   HTMLised: <https://www.sxemacs.org/SYinits/16-riece.html>
;;   Git Repo: git clone https://git.sxemacs.org/syinit
;;   Keywords: init, compile

;; This file is part of SYinit

;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;;
;; 1. Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;;
;; 2. Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;;
;; 3. Neither the name of the author nor the names of any contributors
;;    may be used to endorse or promote products derived from this
;;    software without specific prior written permission.
;;
;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

;;; Commentary:
;;
;;   My Riece settings.
;;
;;   Riece is a very nice IRC client for emacs.  Unlike ERC which
;;   tries to be like "traditional" IRC clients, Riece is much more
;;   emacs like.
;;

;;; Credits:
;;
;;   The HTML version of this file was created with Hrvoje Niksic's
;;   htmlize.el which is part of the XEmacs "text-modes" package.
;;

;;; Todo:
;;
;;     

;;; Code:
(require 'riece-options)
(require 'riece-biff)
(require 'riece-log)
(require 'riece)

;; For flyspell in the command buffer.  See `sy-riece-command-mode-hooks'.
(or (featurep 'overlay)
    (ignore-errors (require 'overlay)))
(or (featurep 'flyspell)
    (ignore-errors (require 'flyspell)))

;; Misc setq's
(setq riece-alias-percent-hack-mask "*.net"
      riece-biff-check-channels '("#sxemacs"
                                  "#emchat"
                                  "#xemacs")
      riece-channel-buffer-mode t
      riece-ctlseq-colors
            '("white" "black" "blue" "green" "red" "brown"
              "purple" "orange" "yellow" "lightgreen" "darkcyan"
              "cyan" "lightblue" "HotPink" "grey35" "grey")
      riece-default-channel-binding nil
      riece-default-coding-system 'utf-8
      riece-desktop-notify-always t
      riece-gather-channel-modes t
      riece-hide-list '(joins parts quits)
      riece-ignore-discard-message nil
      riece-keywords
      '("Bastard" "EMchat" "eMoney" "Gnus" "LFS" "LinuxFromScratch"
        "LineageOS" "Lineage" "Linux From Scratch" "Riece" "SteveYoungs"
        "SXEmacs" "XEmacs" "Youngs" "Steve Youngs" "SYWriting"
        "SY Writing" "Gaiman" "Neil Gaiman" "xwem")
      riece-layout '"bottom-right"
      riece-retry-with-new-nickname t
      riece-server-alist
      '(("roddenberry.freenode.net" :host "roddenberry.freenode.net")
        ("irc.sxemacs.org" :host "irc.sxemacs.org")
        ("irc.freenode.net" :host "irc.freenode.net")
        ("irc.au.freenode.net" :host "irc.au.freenode.net")
        ("irc.nac.net" :host "irc.nac.net")
        ("irc.efnet.org" :host "irc.efnet.org")
        ("irc.efnet.net" :host "irc.efnet.net"))
      riece-user-agent 'emacs-riece-config
      riece-user-list-buffer-mode t)

;; Addons
(riece-command-insinuate-addon 'riece-yank)
(riece-command-insinuate-addon 'riece-hangman)
(riece-command-insinuate-addon 'riece-keepalive)
(riece-command-insinuate-addon 'riece-shrink-buffer)
(riece-command-insinuate-addon 'riece-xfaceb)
(riece-command-insinuate-addon 'riece-button)
(riece-command-insinuate-addon 'riece-epg)

(riece-command-enable-addon 'riece-hangman)

;; Leave this OFF it is too annoying.  Fun, but annoying.
;; (riece-command-insinuate-addon 'riece-doctor)
;; (riece-command-enable-addon 'riece-doctor)

;; A few handy functions that extend Riece's features a bit.
(defvar riece-unread-channels)
(defun sy-riece-clear-unread-chans ()
  "Get rid of the unread mark on all channels."
  (interactive)
  (let ((current riece-current-channel))
    (setq riece-unread-channels nil)
    (riece-switch-to-channel current)))

(defun sy-riece-relist-chans-clear-blanks ()
  "Relist the channel buffer removing any blanks in the sequence.

When you part from a channel/user you are left with a gap in the
sequence of channel numbers in the channels buffer.  This removes
those gaps."
  (interactive)
  (let ((current riece-current-channel))
    (setq riece-current-channels
          (remove-if #'null riece-current-channels))
    (riece-switch-to-channel current)))

(defun sy-riece-command-memoserv (command)
  "Send COMMAND, a string, to MEMOSERV.

With prefix arg, also /join."
  (interactive "sMemoserv: ")
  (when current-prefix-arg
    (riece-command-join (list ["MemoServ" ""])))
  (riece-send-string (format "MEMOSERV %s\r\n" command)))

(defun sy-riece-command-chanserv (command)
  "Send COMMAND, a string, to CHANSERV.

With prefix arg, also /join."
  (interactive "sChanserv: ")
  (when current-prefix-arg
    (riece-command-join (list ["ChanServ" ""])))
  (riece-send-string (format "CHANSERV %s\r\n" command)))

(defun sy-riece-command-nickserv (command)
  "Send COMMAND, a string, to NICKSERV.

With prefix arg, also /join."
  (interactive "sNickserv: ")
  (when current-prefix-arg
    (riece-command-join (list ["NickServ" ""])))
  (riece-send-string (format "NICKSERV %s\r\n" command)))

;; Seems to not exist anymore. :-(
(defun sy-riece-command-seenserv (command)
  "Send COMMAND, a string, to SEENSERV.

SeenServ doesn't actually exist anymore, so this sends `info nick' to
NickServ which gives us the same info.

With prefix arg, also /join."
  (interactive "sLast saw who (nick): ")
  (when current-prefix-arg
    (riece-command-join (list ["NickServ" ""])))
  (riece-send-string (format "NICKSERV info %s\r\n" command)))

(defun sy-riece-command-quick-op ()
  "Request Ops from ChanServ in the current channel."
  (interactive)
  (let ((chan (riece-identity-prefix riece-current-channel)))
    (sy-riece-command-chanserv (format "OP %s" chan))))

(defun sy-riece-command-mute-user (&optional user unmute)
  "Set mode +q on USER, effectively muting them.

Optional prefix arg, UNMUTE to let them speak again."
  (interactive "i\nP")
  (let ((user (or user
                  (completing-read
                   "(Un)Mute user: "
                   (riece-with-server-buffer
                       (riece-identity-server riece-current-channel)
                     (riece-channel-get-users (riece-identity-prefix
                                               riece-current-channel)))))))
    (riece-send-string 
     (format "MODE %s %sq %s\r\n"
             (riece-identity-prefix riece-current-channel)
             (if (or unmute
                     current-prefix-arg)
                 "-"
               "+")
             user))))

(defun sy-riece-list-banned (channel)
  "List the banned users on CHANNEL, current if omitted."
  (interactive "P")
  (let ((channel (if current-prefix-arg
                     (vector (read-string "Channel: ") "")
                   riece-current-channel)))
    (riece-send-string
     (format "MODE %s b\r\n" (riece-identity-prefix channel)))))

(defun sy-riece-command-ban-user (&optional user unban)
  "Ban USER from current channel.

Optional prefix arg, UNBAN removes the ban."
  (interactive "i\nP")
  (let ((user (or user
                  (completing-read
                   "(Un)Ban user: "
                   (riece-with-server-buffer
                       (riece-identity-server riece-current-channel)
                     (riece-channel-get-users (riece-identity-prefix
                                               riece-current-channel))))))
        reason)
    (if (or unban
            current-prefix-arg)
        (riece-send-string
         (format "MODE %s -b %s\r\n"
                 (riece-identity-prefix riece-current-channel)
                 user))
      (setq reason (read-string "Reason: " nil nil
                                "Need a reason?  Look in a mirror!"))
      (riece-send-string
       (format "MODE %s +b %s\r\n"
               (riece-identity-prefix riece-current-channel)
               user))
      (riece-command-kick user reason))))

;; Share the muzak!
(defun sy-riece-say-now-playing (&optional notice)
  "Say into the current channel what mp3 is playing.

With non-nil optional prefix arg, NOTICE, send it as a notice."
  (interactive "P")
  (riece-command-send-message
   (format "NP: %s" (mpd-now-playing)) 
   (and current-prefix-arg
        'notice)))

(defun sy-riece-say-all-purpose (&optional notice)
  "Send the all-purpose answer to everything."
  (interactive "P")
  (riece-command-send-message "Adolf Hitler in fishnets"
                              (if current-prefix-arg
                                  'notice
                                nil)))
  

;; Tell the world what we're using.
(defun sy-riece-say-version (&optional notice)
  "Say the version of Riece we are running.

With non-nil prefix arg, NOTICE, send as a notice."
  (interactive "P")
  (riece-command-send-message
   (format "I'm using: %s" (riece-extended-version))
   (if current-prefix-arg
       'notice
     nil)))

;; say (foo) => bar
(defun sy-riece-send-form ()
  "Sends a form and it's eval"
  (interactive)
  (let* ((form (read-string "sexp: "))
         (value (eval (read form))))
    (riece-command-send-message (format "%s => %s" form value)
                                (if current-prefix-arg
                                    'notice
                                  nil))))

(defun sy-make-rot13-translation-table ()
  "Create a rot13 table."
  (let ((i -1)
        (table (make-string 256 0))
        (a (char-to-int ?a))
        (A (char-to-int ?A)))
    (while (< (incf i) 256)
      (aset table i i))
    (concat
     (substring table 0 A)
     (substring table (+ A 13) (+ A 13 (- 26 13)))
     (substring table A (+ A 13))
     (substring table (+ A 26) a)
     (substring table (+ a 13) (+ a 13 (- 26 13)))
     (substring table a (+ a 13))
     (substring table (+ a 26) 255))))

(defun sy-rot13-string (string)
  "Convert TEXT to rot13-ese."
  (let ((table (sy-make-rot13-translation-table)))
    (with-temp-buffer
      (insert string)
      (translate-region (point-min) (point-max) table)
      (buffer-string))))

(defun sy-riece-send-rot13 (text)
  "Talk in rot13-ese."
  (interactive "srot13: ")
  (riece-command-send-message
   (sy-rot13-string text)
   (if current-prefix-arg
       'notice
     nil)))

(defun sy-morse-string (string)
  "Return STRING in morse code."
  (with-temp-buffer
    (insert string)
    (morse-region (point-min) (point-max))
    (goto-char (point-min))
    (while (re-search-forward "/" nil t)
      (replace-match " "))
    (buffer-string)))

(defun sy-riece-send-morse (text)
  "Talk in morse code."
  (interactive "sMorse: ")
  (riece-command-send-message
   (sy-morse-string text)
   (if current-prefix-arg
       'notice
     nil)))

;; Show off!
(autoload 'riece-command-ctcp-action "riece-ctcp" nil t)
(defun sy-riece-show-off ()
  "Brag about how many channels/people we're talking to."
  (interactive)
  (sy-riece-relist-chans-clear-blanks)
  (let* ((channels riece-current-channels)
         (numchans (length channels))
         (numppl 0)
         currchan)
    (while channels
      (setq currchan (car channels))
      (setq numppl (+ numppl
                      (length (riece-with-server-buffer
                                  (riece-identity-server currchan)
                                (riece-channel-get-users 
                                 (riece-identity-prefix currchan))))))
      (setq channels (cdr channels)))
    (riece-command-ctcp-action
     riece-current-channel
     (format
      "is in %d channels, talking to %d people :-P"
      numchans numppl))))

;; Brag about how long SXEmacs has been up
(defun sy-riece-sxe-uptime ()
  "Display as action SXEmacs uptime."
  (interactive)
  (let* ((ut (uptime))
         (days (car ut))
         (hours (cadr ut))
         (minutes (caddr ut))
         (seconds (cadddr ut)))
    (riece-command-ctcp-action
     riece-current-channel
     (concat "-=[ SXEmacs Uptime: "
             (unless (zerop days)
               (if (eq days 1)
                   "1 day, "
                 (concat (number-to-string days) " days, ")))
             (unless (zerop hours)
               (if (eq hours 1)
                   "1 hour, "
                 (concat (number-to-string hours) " hours, ")))
             (unless (zerop minutes)
               (if (eq minutes 1)
                   "1 minute, "
                 (concat (number-to-string minutes) " minutes, ")))
             (if (zerop seconds)
                 "and 0 seconds"
               (if (eq seconds 1)
                   "and 1 second."
                 (concat "and "
                         (number-to-string seconds)
                         " seconds")))
             " ]=-"))))
      

;; segassem desrever eikeeg ylbirreT
(defun sy-riece-reverse ()
  ".sdrawkcab kaepS"
  (interactive)
  (let ((str (read-string "Say backwards: ")))
    (riece-command-send-message
     (concat (nreverse (string-to-list str))) nil)))

;; .oO0{ what's he thinking? }
(defun sy-riece-think ()
  "Send a .oO0{ think balloon action }."
  (interactive)
  (let ((think (read-string "What are you thinking? ")))
    (riece-command-ctcp-action
     riece-current-channel
     (format ".oO0{ %s }" think))))

;; When pictures speak louder than words...
(defun sy-riece-fuck-you (&optional upyours)
  "For those occasions where... you know what I mean."
  (interactive "P")
  (let ((fuckyou "
     _                         _
    |_|                       |_|
    | |         /^^^\\         | |
   _| |_      (| \"o\" |)      _| |_
 _| | | | _    (_---_)    _ | | | |_
| | | | |' |    _| |_    | `| | | | |
|          |   /     \\   |          |
 \\        /  / /(. .)\\ \\  \\        /
   \\    /  / /  | . |  \\ \\  \\    /
     \\  \\/ /    ||Y||    \\ \\/  /
      \\__/      || ||      \\__/
                () ()
                || ||
               ooO Ooo")
        (upyours "
    .-.    
    |U|    
    | |    
    | |    
   _| |_   
  | | | |-.
 /|     ` |
| |       |
|         |
\\         /
 |       | 
 |       |")
        (riece-yank-tick 0.1))
    (with-temp-buffer
      (if current-prefix-arg 
          (insert upyours)
        (insert fuckyou))
      (kill-region (point-min) (point-max)))
    (riece-command-yank nil nil)))

;; Nick completion.  Lets face it, compared to other IRC clients like
;; BitchX or even ERC, Riece's nick completion is pretty sucky. :-(
;; This is my vain attempt to improve it.
(defun sy-riece-command-complete-user ()
  "Like `riece-command-complete-user' but restrict to current chan.

This version of nick completion maintains the original case of the
nick being completed.  The version in Riece downcases the completion
\(could be a bug\).

If the completion is being inserted at column zero, `: ' is appended,
otherwise ` ' is added.

The following is not yet implemented, but I'd also like to be able to
complete from the middle of a nick...

  Nickname     User Types      Expands To
  --------     ----------      ----------
  MyNick        nic<TAB>       MyNick:<SPC>"
  (interactive)
  (let* ((completion-ignore-case t)
         (table (riece-with-server-buffer
                    (riece-identity-server riece-current-channel)
                  (riece-channel-get-users (riece-identity-prefix
                                            riece-current-channel))))
         (current (or (current-word) ""))
         (completion (try-completion current table))
         (all (all-completions current table)))
    (if (eq completion t)
        nil
      (if (null completion)
          (message "Can't find completion for \"%s\"" current)
        (if (equal current completion)
            (with-output-to-temp-buffer "*Help*"
              (display-completion-list all))
          (re-search-forward "\\>" nil t)
          (delete-region (point) (- (point) (length current)))
          (if (eq (point) (point-at-bol))
              (insert completion ": ")
            (insert completion " ")))))))

;(defalias 'riece-command-complete-user 'sy-riece-command-complete-user)

;; "schme" <marcus@sxemacs.org> funky cycling completion
;; Reworked to support cycling in both directions using dllists, plus
;; other misc improvements by me. --SY.
(defvar riece-me:completion-time 3
  "Time in seconds before completion list is reset.")
(defvar riece-me:*completion-timer* (make-itimer)
  "Completion timer.")
(defvar riece-me:*completion-list* nil
  "Completion list.")

(defvar sy-riece-nick-syntax-table
  (let ((table (copy-syntax-table text-mode-syntax-table)))
    (modify-syntax-entry ?~  "w " table)
    (modify-syntax-entry ?`  "w " table)
    (modify-syntax-entry ?-  "w " table)
    (modify-syntax-entry ?_  "w " table)
    (modify-syntax-entry ?+  "w " table)
    (modify-syntax-entry ?{  "w " table)
    (modify-syntax-entry ?[  "w " table)
    (modify-syntax-entry ?}  "w " table)
    (modify-syntax-entry ?]  "w " table)
    (modify-syntax-entry ?\\ "w " table)
    (modify-syntax-entry ?|  "w " table)
    (modify-syntax-entry ?:  "w " table)
    (modify-syntax-entry ?\; "w " table)
    (modify-syntax-entry ?'  "w " table)
    (modify-syntax-entry ?<  "w " table)
    (modify-syntax-entry ?,  "w " table)
    (modify-syntax-entry ?>  "w " table)
    table)
  "Syntax table used in funky nick cycling completion.")

(defun sy-riece-init-completion-timer ()
  "Initialise the completion timer."
  (let ((timer riece-me:*completion-timer*))
    (set-itimer-function timer #'(lambda ()
                                   (setq riece-me:*completion-list* nil)))
    (set-itimer-value timer riece-me:completion-time)))
(add-hook 'riece-after-login-hook #'sy-riece-init-completion-timer)

(defsubst sy-riece-cycle-list (list &optional reverse)
  "Return a list of head of LIST, and LIST rotated 1 place forward.

If optional argument, REVERSE is non-nil, rotate the list in the other
direction."
  (let ((list (apply #'dllist list))
        name)
    (if reverse
        (dllist-rrotate list)
      (dllist-lrotate list))
    (setq name (dllist-car list))
    (list name (dllist-to-list list))))

(defsubst sy-riece-set-completion-timer ()
  "(Re)set completion timer's value."
  (let ((timer riece-me:*completion-timer*))
    (and (itimerp timer)
         (set-itimer-value timer riece-me:completion-time))))

(defun sy-riece-complete-user-backwards ()
  "Complete nick, cycling backwards.
See `riece-me:command-complete-user'."
  (interactive)
  (riece-me:command-complete-user 'reverse))

(defun sy-riece-command-mode-hooks ()
  "Add some nice stuff in Riece's command buffer."
  (when (eq major-mode 'riece-command-mode)
    ;; Define a few keys here so they don't have the `C-c' prefix
    (local-set-key [iso-left-tab] #'sy-riece-complete-user-backwards)
    (local-set-key [(super next)] #'riece-command-user-list-scroll-up)
    (local-set-key [(super prior)] #'riece-command-user-list-scroll-down)
    (local-set-key [(hyper next)] #'riece-command-scroll-up)
    (local-set-key [(hyper prior)] #'riece-command-scroll-down)
    ;; Turn on flyspell mode if available
    (and (featurep (and 'overlay 'flyspell))
         (flyspell-mode 1))))

(add-hook 'riece-command-mode-hook #'sy-riece-command-mode-hooks)


(defun riece-me:command-complete-user (&optional reverse)
  "Like `riece-command-complete-user' but restrict to current chan.

This completion does not pop up any completion buffers, instead it
cycles through the user names \"in-place\" with each successive TAB.

With non-nil optional argument, REVERSE, the cycling goes in the other
direction.

If the completion is being inserted at column zero, \": \" is appended,
otherwise \" \" is added. "
  (interactive)
  (unless riece-me:*completion-list*
    (unless (itimer-live-p riece-me:*completion-timer*)
      (sy-riece-set-completion-timer)
      (activate-itimer riece-me:*completion-timer*))
    (let* ((completion-ignore-case t)
           (table (riece-with-server-buffer
                      (riece-identity-server riece-current-channel)
                    (riece-channel-get-users (riece-identity-prefix
                                              riece-current-channel))))
           (current (current-word))
           (completion (try-completion current table))
           (all (all-completions current table)))
      (if (null completion)
          (message "Can't find completion for \"%s\"" current)
        (setq riece-me:*completion-list* all))))
  (when riece-me:*completion-list*
    (multiple-value-bind (completion newlist)
        (sy-riece-cycle-list riece-me:*completion-list* reverse)
      (setq riece-me:*completion-list* newlist)
      (with-syntax-table sy-riece-nick-syntax-table
        (unless (string= "" (current-word))
          (backward-delete-word))
        (insert completion)
        (let ((nicksuffix " "))
          (save-excursion
            (backward-word)
            (and (bolp)
                 (setq nicksuffix ": ")))
          (insert nicksuffix)))
      (sy-riece-set-completion-timer))))

(defalias 'riece-command-complete-user 'riece-me:command-complete-user)
;;;

(defun sy-riece-add-rem-biff-channel (&optional remove)
  "Add the current channel to the list of channels for riece-biff.

With optional prefix arg, REMOVE, remove the current channel from the
biff list."
  (interactive "P")
  (if (or current-prefix-arg
          remove)
      ;; Remove chan.
      (progn
        (setq riece-biff-check-channels
              (remove (riece-identity-prefix riece-current-channel)
                      riece-biff-check-channels))
        (message "Channel: %s removed from riece-biff channel list."
                 (riece-identity-prefix riece-current-channel)))
    ;; Add chan.
    (add-to-list 'riece-biff-check-channels
                 (riece-identity-prefix riece-current-channel))
    (message "Channel: %s added to riece-biff channel list."
             (riece-identity-prefix riece-current-channel))))

(defun sy-riece-get-sxemacs-topic-version ()
  "Return the \"version\" section of #sxemacs topic."
  (let* ((topic (riece-with-server-buffer
                    (riece-identity-server riece-current-channel)
                  (riece-channel-get-topic "#sxemacs")))
         (ver (third (split-string-by-char topic ?\ ))))
    ver))

(defun sy-riece-sxemacs-topic-version-update (&optional newver)
  "*Updates the \"version\" section of #sxemacs topic with NEWVER.
With a prefix arg, prompt for the new version string."
  (interactive "P")
  (let* ((oldver (sy-riece-get-sxemacs-topic-version))
         (gitver (substring (shell-command-to-string
                             "( cd ${SXEWD}; git describe master )")
                            0 -1))
         (newver (or (and current-prefix-arg
                          (read-string "New Version: "
                                       sxemacs-git-version nil
                                       sxemacs-git-version))
                     gitver))
        (chan (riece-identity-prefix riece-current-channel)))
    (unless (string= chan "#sxemacs")
      (error 'invalid-argument "Wrong channel" chan))
    (riece-command-send-message
     (format ",topic change 1 s/%s/%s/" oldver newver) nil)))

;; Define keys for those functions.
(define-key riece-command-map (kbd "C-c C") #'sy-riece-clear-unread-chans)
(define-key riece-command-map (kbd "C-c r")
  #'sy-riece-relist-chans-clear-blanks)
(define-key riece-command-map (kbd "C-c m") #'sy-riece-command-mute-user)
(define-key riece-command-map (kbd "C-b") #'sy-riece-command-ban-user)
(define-key riece-command-map (kbd "C-o") #'sy-riece-command-quick-op)
(define-key riece-command-map (kbd "C-c n") #'sy-riece-say-now-playing)
(define-key riece-command-map (kbd "C-c V") #'sy-riece-say-version)
(define-key riece-command-map (kbd "C-c s") #'sy-riece-show-off)
(define-key riece-command-map (kbd "C-c f") #'sy-riece-fuck-you)
(define-key riece-command-map (kbd "C-c b") #'sy-riece-add-rem-biff-channel)
(define-key riece-command-map (kbd "C-c ?") #'sy-riece-think)
(define-key riece-command-map (kbd "C-c R") #'sy-riece-reverse)
(define-key riece-command-map (kbd "C-c T") #'sy-riece-sxemacs-topic-version-update)
(define-key riece-command-map (kbd "C-c U") #'sy-riece-sxe-uptime)
(define-key riece-command-map [a] #'sy-riece-say-all-purpose)

;; So I can start Riece in a new frame
(defvar riece-frame nil
  "Frame for Riece.")

(defun sy-riece (&optional ask)
  "Run Riece in a new frame.

With non-nil optional prefix ASK Riece will prompt for a server to
connect to."
  (interactive "P")
  (let ((riece-server (if current-prefix-arg
                          nil
                        "irc.sxemacs.org")))
    (setq riece-frame (new-frame '((name . "RieceFrame")
                                   (width . 110))))
    (select-frame riece-frame)
    (call-interactively 'riece)
    (focus-frame riece-frame)))

(defun sy-riece-exit-hook ()
  (when (frame-live-p riece-frame)
    (delete-frame riece-frame))
  (setq riece-frame nil))

(add-hook 'riece-exit-hook #'sy-riece-exit-hook)

;; riece-startup-channel-list doesn't fit in with the way I do things
;; and the way freenode functions.  It gets called too damned early.
;; What follows is my attempt to make Riece behave better with logging
;; into freenode, registering to nickserv, joining initial channels,
;; and getting ops with chanserv.
(defvar sy-riece-startup-channel-list
  '("#sxemacs"
    "#emchat"
    "#xemacs"
    "#emacs"
    ;"#kde"
    ;"#kde-devel"
    "#LineageOS"
    ;"#LineageOS-dev"
    "#lxqt"
    ;"#postgresql"
    ;"#systemd"
    "#zsh"
    )
  "List of channels to join after logging in and identifying to nickserv.")

;; Set up channel coding systems
;;
;; This is a PITA... turn on utf and can't read iso-8859-1 special
;; chars, turn it off and can't read utf.  Have I mentioned how much I
;; hate this crap? --SY.
(mapcar
 #'(lambda (chan)
     (if (string-match #r"#\(sxemacs\|emchat\)" chan)
         (push (cons chan 'iso-8859-1) riece-channel-coding-system-alist)
       (push (cons chan 'utf-8) riece-channel-coding-system-alist)))
 sy-riece-startup-channel-list)

(defun sy-riece-login ()
  (progn
    (riece-send-string (format "PRIVMSG NickServ :identify %s\r\n"
                               (getenv "IRCPASSWD")))
    (sleep-for 15))
  (let ((channel-list sy-riece-startup-channel-list)
        entry identity)
    (while channel-list
      (unless (listp (setq entry (car channel-list)))
        (setq entry (list (car channel-list))))
      (if (equal (riece-identity-server
                  (setq identity (riece-parse-identity (car entry))))
                 riece-server-name)
          (riece-command-join-channel identity (nth 1 entry)))
      (setq channel-list (cdr channel-list))))
  (riece-send-string "PRIVMSG ChanServ :op #sxemacs\r\n")
  (riece-send-string "PRIVMSG ChanServ :op #emchat\r\n")
  (riece-send-string "PRIVMSG ChanServ :op #xemacs\r\n")
  (riece-send-string
   (format "PRIVMSG SXEbot :identify SteveYoungs %s\r\n"
           (getenv "BOTPASSWD"))))

(add-hook 'riece-after-login-hook #'sy-riece-login)

;; Until I can find a solution to my hook problem (login hook not
;; running to completion) I use this to finish the job
(defun sy-riece-cleanup-login ()
  (interactive)
  (let ((metachans
         #r".*\.freenode\.net\|\(Chan\|Nick\|Memo\|Seen\)Serv\|SXEbot\|freenode-connect"))
    (mapcar
     #'(lambda (chan-vect)
         (mapcar
          #'(lambda (chan)
              (and (string-match metachans chan)
                   (riece-part-channel chan-vect)))
          chan-vect))
     riece-current-channels)
    (sy-riece-relist-chans-clear-blanks)
    (riece-command-switch-to-channel-by-number 1)))

;; CANNOT get this to work from the hook.  I suspect it is a
;; networking/async/timing thing.  I have it bound to a key
;; seq... `C-c C-c l', a PITA though.
;(add-hook 'riece-after-login-hook #'sy-riece-cleanup-login 'append)
(define-key riece-command-map (kbd "C-c l") 'sy-riece-cleanup-login)

;; Automatically clear Riece Biff indicator by switching to the right
;; window/frame
(defun sy-riece-check-command-buffer ()
  (and (get-buffer-window (or riece-command-buffer "*Command*"))
       (riece-biff-clear)))

(defadvice switch-to-buffer (after riece-update (&rest args) activate)
  "After switching buffers, check to see if riece-biff should be cleared.
The riece-biff modeline indicator will only be cleared if
`riece-command-buffer' is visible in the selected frame."
  (sy-riece-check-command-buffer))

(add-hook 'select-frame-hook #'sy-riece-check-command-buffer)

;; Easier switch to Riece when running on TTY.
(defun sy-switch-to-riece ()
  "I use this to switch to Riece when I'm on a tty."
  (interactive)
  (when (buffer-live-p riece-command-buffer)
    (pop-to-buffer riece-command-buffer)
    (riece-command-configure-windows)))

(define-key global-tty-map [(control ?c) ?r] #'sy-switch-to-riece)

;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
(message "Riece settings loaded successfully")

Copyright © 2020 Steve Youngs
Verbatim copying and distribution is permitted in any medium, providing this notice is preserved.
Last modified: Wed Apr 15 18:15:57 AEST 2020