dotfiles/emacs/.emacs.d/vendor-lisp/sermon/sermon.el

;;; sermon.el --- Clean up Circe buffers  -*- lexical-binding: t; -*-

;; Copyright (C) 2016  Tom Willemse

;; Author: Tom Willemse <chelys@drd>
;; Keywords: convenience

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This is an extension module for Circe.  It creates what I think is
;; a more minimalistic view of Circe buffers.  It right-aligns all the
;; nicks, right-justifies and simplifies certain messages.  It takes
;; care of both `fill-prefix' and `wrap-prefix' so it should be usable
;; with and without `lui-fill-type'.

;; The name sermon was chosen because it's pronounced somewhat
;; similarly to cermin, which is an amalgamation of circe
;; minimalistic.

;;; Code:

(defvar sermon-longest-nick 0
  "The longest known nick.")
(make-variable-buffer-local 'sermon-longest-nick)

(defvar sermon-original-format-say nil
  "The original value of `circe-format-say'.")
(defvar sermon-original-format-self-say nil
  "The original value of `circe-format-self-say'.")
(defvar sermon-original-format-action nil
  "The original value of `circe-format-action'.")
(defvar sermon-original-format-self-action nil
  "The original value of `circe-format-self-action'.")
(defvar sermon-original-format-server-message nil
  "The original value of `circe-format-server-message'.")
(defvar sermon-original-format-server-join-in-channel nil
  "The original value of `circe-format-server-join-in-channel'.")
(defvar sermon-original-format-server-join nil
  "The original value of `circe-format-server-join'.")
(defvar sermon-original-format-server-quit nil
  "The original value of `circe-format-server-quit'.")
(defvar sermon-original-format-server-quit-channel nil
  "The original value of `circe-format-server-quit-channel'.")
(defvar sermon-original-format-server-part nil
  "The original value of `circe-format-server-part'.")
(defvar sermon-original-format-server-nick-change nil
  "The original value of `circe-format-server-nick-change'.")
(defvar sermon-original-format-server-topic nil
  "The original vlaue of `circe-format-server-topic'.")

(defun sermon--fill-string ()
  (make-string (+ sermon-longest-nick 3) ?\s))

(defun sermon--update-longest-nick (keywords)
  (let* ((nick (plist-get keywords :nick))
         (len (length nick)))
    (when (> len sermon-longest-nick)
      (setq sermon-longest-nick len)
      (when lui-fill-type
        (setq-local lui-fill-type (sermon--fill-string))))))

(defun sermon-say-formatter (&rest keywords)
  (sermon--update-longest-nick keywords)
  (propertize
   (lui-format (format "{nick:%ds}   {body}" sermon-longest-nick)
               keywords)
   'wrap-prefix (sermon--fill-string)))

(defun sermon-self-say-formatter (&rest keywords)
  (propertize (format (format "%%%ds   %%s" sermon-longest-nick)
                      ">" (plist-get keywords :body))
              'wrap-prefix (sermon--fill-string)))

(defun sermon-action-formatter (&rest keywords)
  (propertize
   (lui-format
    (format "{intro:%ds}   {nick} {body}" sermon-longest-nick)
    (plist-put keywords :intro "*"))
   'wrap-prefix (sermon--fill-string)))

(defun sermon-server-message-formatter (&rest keywords)
  (propertize
   (lui-format
    (format "{intro:%ds}   {body}" sermon-longest-nick)
    (plist-put keywords :intro "***"))
   'wrap-prefix (sermon--fill-string)))

(defun sermon-server-join-in-channel-formatter (&rest keywords)
  (propertize
   (lui-format
    (format "{intro:%ds}   {nick} joined {channel}"
            sermon-longest-nick)
    (plist-put keywords :intro ">>>"))
   'wrap-prefix (sermon--fill-string)))

(defun sermon-server-join-formatter (&rest keywords)
  (propertize
   (lui-format
    (format "{intro:%ds}   {nick} logged on"
            sermon-longest-nick)
    (plist-put keywords :intro ">>>"))
   'wrap-prefix (sermon--fill-string)))

(defun sermon-server-quit-formatter (&rest keywords)
  (propertize
   (lui-format
    (format "{intro:%ds}   {nick} logged off"
            sermon-longest-nick)
    (plist-put keywords :intro "<<<"))
   'wrap-prefix (sermon--fill-string)))

(defun sermon-server-quit-channel-formatter (&rest keywords)
  (propertize
   (lui-format
    (format "{intro:%ds}   {nick} left {channel}"
            sermon-longest-nick)
    (plist-put keywords :intro "<<<"))
   'wrap-prefix (sermon--fill-string)))

(defun sermon-server-part-formatter (&rest keywords)
  (propertize
   (lui-format
    (format "{intro:%ds}   {nick} parted from {channel}"
            sermon-longest-nick)
    (plist-put keywords :intro "***"))
   'wrap-prefix (sermon--fill-string)))

(defun sermon-server-nick-change-formatter (&rest keywords)
  (propertize
   (lui-format
    (format "{intro:%ds}   {old-nick} is now know as {new-nick}"
            sermon-longest-nick)
    (plist-put keywords :intro "***"))
   'wrap-prefix (sermon--fill-string)))

(defun sermon-server-topic-formatter (&rest keywords)
  (propertize
   (lui-format
    (format "{intro:%ds}   {nick} changed topic to: {new-topic}"
            sermon-longest-nick)
    (plist-put keywords :intro "***"))
   'wrap-prefix (sermon--fill-string)))

;;;###autoload
(defun enable-sermon ()
  (interactive)
  (if (null sermon-original-format-say)
      (setq sermon-original-format-say
            circe-format-say))
  (setq circe-format-say #'sermon-say-formatter)

  (if (null sermon-original-format-self-say)
      (setq sermon-original-format-self-say
            circe-format-self-say))
  (setq circe-format-self-say #'sermon-say-formatter)

  (if (null sermon-original-format-action)
      (setq sermon-original-format-action
            circe-format-action))
  (setq circe-format-action #'sermon-action-formatter)

  (if (null sermon-original-format-self-action)
      (setq sermon-original-format-self-action
            circe-format-self-action))
  (setq circe-format-self-action #'sermon-action-formatter)

  (if (null sermon-original-format-server-message)
      (setq sermon-original-format-server-message
            circe-format-server-message))
  (setq circe-format-server-message #'sermon-server-message-formatter)

  (if (null sermon-original-format-server-join-in-channel)
      (setq sermon-original-format-server-join-in-channel
            circe-format-server-join-in-channel))
  (setq circe-format-server-join-in-channel
        #'sermon-server-join-in-channel-formatter)

  (if (null sermon-original-format-server-join)
      (setq sermon-original-format-server-join
            circe-format-server-join))
  (setq circe-format-server-join #'sermon-server-join-formatter)

  (if (null sermon-original-format-server-quit)
      (setq sermon-original-format-server-quit
            circe-format-server-quit))
  (setq circe-format-server-quit #'sermon-server-quit-formatter)

  (if (null sermon-original-format-server-quit-channel)
      (setq sermon-original-format-server-quit-channel
            circe-format-server-quit-channel))
  (setq circe-format-server-quit-channel
        #'sermon-server-quit-channel-formatter)

  (if (null sermon-original-format-server-part)
      (setq sermon-original-format-server-part
            circe-format-server-part))
  (setq circe-format-server-part #'sermon-server-part-formatter)

  (if (null sermon-original-format-server-nick-change)
      (setq sermon-original-format-server-nick-change
            circe-format-server-nick-change))
  (setq circe-format-server-nick-change
        #'sermon-server-nick-change-formatter)

  (if (null sermon-original-format-server-topic)
      (setq sermon-original-format-server-topic
            circe-format-server-topic))
  (setq circe-format-server-topic
        #'sermon-server-topic-formatter))

(defun disable-sermon ()
  (interactive)
  (setq circe-format-say sermon-original-format-say
        sermon-original-format-say nil
        circe-format-self-say sermon-original-format-self-say
        sermon-original-format-self-say nil
        circe-format-action sermon-original-format-action
        sermon-original-format-action nil
        circe-format-self-action sermon-original-format-self-action
        sermon-original-format-self-action nil
        circe-format-server-message sermon-original-format-server-message
        sermon-original-format-server-message nil
        circe-format-server-join-in-channel sermon-original-format-server-join-in-channel
        sermon-original-format-server-join-in-channel nil
        circe-format-server-join sermon-original-format-server-join
        sermon-original-format-server-join nil
        circe-format-server-quit sermon-original-format-server-quit
        sermon-original-format-server-quit nil
        circe-format-server-quit-channel sermon-original-format-server-quit-channel
        sermon-original-format-server-quit-channel nil
        circe-format-server-part sermon-original-format-server-part
        sermon-original-format-server-part nil
        circe-format-server-nick-change sermon-original-format-server-nick-change
        sermon-original-format-server-nick-change nil
        circe-format-server-topic sermon-original-format-server-topic
        sermon-original-format-topic nil))

(provide 'sermon)
;;; sermon.el ends here