1 ;;; zenirc-fill.el --- fill messages in zenirc
3 ;; Copyright (C) 1995 Noah S. Friedman
4 ;; Copyright (C) 1995, 1996, 1997, 1998 Per Persson
6 ;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
7 ;; Per Persson <pp@sno.pp.se>
8 ;; Maintainer: pp@sno.pp.se
9 ;; Keywords: extensions
10 ;; Created: 1995-03-16
12 ;; This program is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; This program is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with this program; if not, you can either send email to this
24 ;; program's maintainer or write to: The Free Software Foundation,
25 ;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
32 (defvar zenirc-fill-mode nil
33 "*If non-nil, then fill messages fitting `zenirc-fill-message-categories'.
34 This is buffer-local.")
35 (make-variable-buffer-local 'zenirc-fill-mode)
37 (defvar zenirc-fill-region-function 'zenirc-wrap-region
38 "*Function to use for filling.")
40 (defvar zenirc-fill-prefix " | "
41 "*String for filling to insert at front of new lines, or nil for none.")
43 (defvar zenirc-fill-static 12
44 "*How many chars into first the line the first word should end.
45 This will look totally ridicolous if you don't strip away !user@host from
48 (defvar zenirc-fill-column (- (window-width) 2)
49 "*Column beyond which line-wrapping should happen in zenirc buffers.")
51 (defvar zenirc-fill-message-categories
52 '(privmsg privmsg_you notice notice_you privmsg_nochannel
53 notice_nochannel ctcp_action)
54 "*ZenIRC message categories to fill as paragraphs.
55 This should be a list consisting of symbols corresponding to the type of
56 messages in the message catalog which should be filled as paragraphs.
57 For example, private messages (`privmsg') and notices (`notice') are good
60 If this variable is set to `t', then all messages are filled.
61 If this variable is set to `nil', then no messages are filled.")
63 (defvar zenirc-fill-nonstandard-message-categories-p nil
64 "If non-nil, then fill messages that are not in a standard category.
65 That is, fill messages which did not originate from the message catalog,
66 and thus have no category symbol.")
69 (defun zenirc-fill-mode (&optional prefix)
70 "Enable or disable line wrapping of irc messages.
72 A negative prefix argument disables this mode.
73 A non-negative prefix argument enables it.
74 If no prefix argument is given, toggle the current state of the mode.
76 The user may also enable or disable this mode simply by setting the
77 variable of the same name."
81 (setq zenirc-fill-mode (not zenirc-fill-mode)))
82 ((>= (prefix-numeric-value prefix) 0)
83 (setq zenirc-fill-mode t))
85 (setq zenirc-fill-mode nil)))
86 (cond ((not (interactive-p)))
88 (message "zenirc-fill-mode is enabled"))
90 (message "zenirc-fill-mode is disabled")))
93 ;; "normal" filling function.
94 (defun zenirc-fill-region (beg end win-width)
95 (let* ((fill-prefix zenirc-fill-prefix)
96 (fill-column zenirc-fill-column))
97 (fill-region-as-paragraph (point-min) (1- (point-max))))
98 ;; this filling function adds an unnecessary newline.
99 (goto-char (point-max))
102 ;; This is like the normal filling routines except that it doesn't squash
103 ;; whitespace (except at line breaks). This will make ascii barphics and
104 ;; other random spaced crap easier to see.
105 (defun zenirc-wrap-region (beg end win-width)
110 (narrow-to-region beg end)
112 (prefix-length (length zenirc-fill-prefix))
113 (fill-column (max (or zenirc-fill-column
118 (while (< (point) (point-max))
120 (setq line-beg (+ (point) prefix-length))
121 (cond ((< fill-column (- (point-max) (point)))
122 (forward-char fill-column)
123 (cond ((or (memq (char-after (point)) '(32 ?\t))
124 (re-search-backward ws line-beg t)
125 (re-search-forward ws (point-max) t))
128 (insert "\n" (or zenirc-fill-prefix "")))
130 (goto-char (point-max)))))
132 (goto-char (point-max))))))))))
134 ;; This adds whitespaces before the first word on every line but the first
135 ;; one to match up with the length of the first word on the first line.
136 (defun zenirc-wrap-region-dynamic (beg end win-width)
141 ;; trim trailing whitespace
142 (goto-char (- end 1))
144 (if (< (+ beg 1) (point))
148 (narrow-to-region beg end)
151 ; set the length of the prefix
153 (or (and (search-forward " " end t)
154 (- (match-end 0) beg))
157 ; how many columns zenirc-wrap-region should keep inside
158 (fill-column (max (or zenirc-fill-column
160 (or prefix-length 0)))
163 ; start wrapping of the actual message, after first word
164 (while (< (point) (point-max))
166 (setq line-beg (+ (point) prefix-length))
167 (cond ((< fill-column (- (point-max) (point)))
168 (forward-char fill-column)
169 (cond ((or (memq (char-after (point)) '(32 ?\t))
170 (re-search-backward ws line-beg t)
171 (re-search-forward ws (point-max) t))
172 ; remove all spaces before adding newline
177 (make-string prefix-length
178 (string-to-char " "))))
180 (goto-char (point-max)))))
182 (goto-char (point-max))))))))))
184 ;; This adds whitespaces before the first word on every line so that the
185 ;; second word on the first line and the first word on every other line
186 ;; match up with all the other lines (not just in this region).
187 (defun zenirc-wrap-region-static (beg end win-width)
192 (narrow-to-region beg end)
195 ; set the length of the prefix
197 (and (search-forward " " end t)
198 (- (match-end 0) beg)))
199 ; how many columns zenirc-wrap-region should keep inside
200 (fill-column (max (or zenirc-fill-column
205 (if (<= prefix-length zenirc-fill-static)
208 (- zenirc-fill-static prefix-length)
209 (string-to-char " ")))
210 ; update the length of the prefix, as it is static
211 (setq prefix-length zenirc-fill-static)))
212 ; start wrapping of the actual message, after first word
213 (while (< (point) (point-max))
215 (setq line-beg (+ (point) prefix-length))
216 (cond ((< fill-column (- (point-max) (point)))
217 (forward-char fill-column)
218 (cond ((or (memq (char-after (point)) '(32 ?\t))
219 (re-search-backward ws line-beg t)
220 (re-search-forward ws (point-max) t))
221 ; remove all spaces before adding newline
226 (make-string zenirc-fill-static
227 (string-to-char " "))))
229 (goto-char (point-max)))))
231 (goto-char (point-max))))))))))
234 (defvar zenirc-window-last-width 80)
235 (defun zenirc-fill-message (proc sym string)
237 (get-buffer-window (process-buffer proc) t)))
239 (setq zenirc-window-last-width (window-width w))
240 zenirc-window-last-width)))
241 (and zenirc-fill-mode
242 (cond ((eq zenirc-fill-message-categories t))
244 zenirc-fill-nonstandard-message-categories-p)
245 ((memq sym zenirc-fill-message-categories))
247 (funcall zenirc-fill-region-function
248 (point-min) (point-max) win-width))))
250 (defvar zenirc-fill-outgoing-mode nil
251 "*If non-nil, then fill outgoing PRIVMSG/NOTICEs.
252 This is buffer-local.")
253 (make-variable-buffer-local 'zenirc-fill-outgoing-mode)
255 (defvar zenirc-fill-outgoing-prefix "-> "
256 "*What do add before outgoing lines.")
258 (defun zenirc-fill-outgoing-mode (&optional prefix)
259 "Enable or disable line wrapping of outgoing PRIVMSG/NOTICEs.
261 A negative prefix argument disables this mode.
262 No argument or any non-negative argument enables it.
264 The user may also enable or disable this mode simply by setting the
265 variable of the same name."
269 (setq zenirc-fill-outgoing-mode (not zenirc-fill-outgoing-mode)))
270 ((>= (prefix-numeric-value prefix) 0)
271 (setq zenirc-fill-outgoing-mode t))
273 (setq zenirc-fill-outgoing-mode nil)))
274 (cond ((not (interactive-p)))
275 (zenirc-fill-outgoing-mode
276 (message "zenirc-fill-outgoing-mode is enabled"))
278 (message "zenirc-fill-outgoing-mode is disabled")))
279 zenirc-fill-outgoing-mode)
281 (defun zenirc-fill-outgoing (beg end str)
282 (if zenirc-fill-outgoing-mode
285 ; if the outgoing line isn't a command, just insert the prefix
286 (if (not (= (aref str 0) zenirc-command-char))
288 (insert zenirc-fill-outgoing-prefix)
290 (narrow-to-region beg end)
291 (funcall zenirc-fill-region-function
292 beg end (window-width))))
294 ; if the outgoing line was a command, parse out the
295 ; actual command and the argument/text.
296 ((command (car (zenirc-parse-firstword
298 (text (cdr (zenirc-parse-firstword str))))
300 ; if the command was one of 'm', 'msg' or 'privmsg',
301 ; do some fanzy parsing and change the line a bit.
302 ((string-match "\\(^m$\\|^msg$\\|^privmsg$\\)" command)
303 (delete-region beg end)
304 (insert zenirc-fill-outgoing-prefix
305 "*" (car (zenirc-parse-firstword text)) "* "
306 (cdr (zenirc-parse-firstword text)))
308 (narrow-to-region beg end)
309 (funcall zenirc-fill-region-function
310 beg end (window-width)))))))
314 (defvar zenirc-command-resize-hook '(zenirc-command-resize))
317 (defun zenirc-command-resize (proc cmd)
318 (if (string= (cdr cmd) "")
319 (setq zenirc-fill-column (- (window-width) 2))
320 (setq zenirc-fill-column (cdr cmd))))
322 (provide 'zenirc-fill)
324 (zenirc-add-hook 'zenirc-message-hook 'zenirc-fill-message)
325 (zenirc-add-hook 'zenirc-send-line-hook 'zenirc-fill-outgoing)
327 (or (assq 'zenirc-fill-mode minor-mode-alist)
328 (setq minor-mode-alist
329 (cons (list 'zenirc-fill-mode " Zfill") minor-mode-alist)))
331 ;;; zenirc-fill.el ends here