aboutsummaryrefslogtreecommitdiffstats
path: root/emacs/.emacs.d/vendor-lisp/sermon/sermon.el
blob: 6e55de502e8e2cca90f22f2267a7e42629df7e9c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
;;; 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