d328f9b6d9469435066b4256eceb447618dba4ba
[riece] / lisp / riece.el
1 ;;; riece.el --- IRC client for Emacsen
2 ;; Copyright (C) 1998-2003 Daiki Ueno
3
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
5 ;; Created: 1998-09-28
6 ;; Keywords: IRC, riece
7
8 ;; This file is part of Riece.
9
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
24
25 ;;; Code:
26
27 (require 'riece-filter)
28 (require 'riece-display)
29 (require 'riece-server)
30 (require 'riece-compat)
31 (require 'riece-commands)
32
33 (autoload 'make-ring "ring")
34
35 (defvar riece-channel-list-mode-map (make-sparse-keymap))
36 (defvar riece-user-list-mode-map (make-sparse-keymap))
37
38 (defvar riece-dialogue-mode-map
39   (let ((keymap (make-keymap)))
40     (suppress-keymap keymap 'nodigit)
41     keymap))
42
43 (defvar riece-command-mode-map (make-keymap))
44 (defvar riece-command-map (make-sparse-keymap))
45
46 (defvar riece-command-mode-syntax-table nil)
47
48 (put 'riece-command-mode 'mode-class 'special)
49 (put 'riece-dialogue-mode 'mode-class 'special)
50 (put 'riece-channel-list-mode 'mode-class 'special)
51 (put 'riece-user-list-mode 'mode-class 'special)
52 (put 'riece-channel-mode 'derived-mode-parent 'riece-dialogue-mode)
53 (put 'riece-others-mode 'derived-mode-parent 'riece-dialogue-mode)
54
55 (defvar riece-buffer-mode-alist
56   '((riece-command-buffer . riece-command-mode)
57     (riece-dialogue-buffer . riece-dialogue-mode)
58     (riece-others-buffer . riece-others-mode)
59     (riece-user-list-buffer . riece-user-list-mode)
60     (riece-channel-list-buffer . riece-channel-list-mode)
61     (riece-private-buffer . riece-dialogue-mode)
62     (riece-wallops-buffer)))
63     
64 (defvar riece-select-keys
65   '("1" riece-command-switch-to-channel-by-number-1
66     "2" riece-command-switch-to-channel-by-number-2
67     "3" riece-command-switch-to-channel-by-number-3
68     "4" riece-command-switch-to-channel-by-number-4
69     "5" riece-command-switch-to-channel-by-number-5
70     "6" riece-command-switch-to-channel-by-number-6
71     "7" riece-command-switch-to-channel-by-number-7
72     "8" riece-command-switch-to-channel-by-number-8
73     "9" riece-command-switch-to-channel-by-number-9
74     "0" riece-command-switch-to-channel-by-number-10
75     "\C-c1" riece-command-switch-to-channel-by-number-11
76     "\C-c2" riece-command-switch-to-channel-by-number-12
77     "\C-c3" riece-command-switch-to-channel-by-number-13
78     "\C-c4" riece-command-switch-to-channel-by-number-14
79     "\C-c5" riece-command-switch-to-channel-by-number-15
80     "\C-c6" riece-command-switch-to-channel-by-number-16
81     "\C-c7" riece-command-switch-to-channel-by-number-17
82     "\C-c8" riece-command-switch-to-channel-by-number-18
83     "\C-c9" riece-command-switch-to-channel-by-number-19
84     "\C-c0" riece-command-switch-to-channel-by-number-20))
85
86 ;;; Keymap macros. -- borrowed from `gnus-util.el'.
87 (defmacro riece-local-set-keys (&rest plist)
88   "Set the keys in PLIST in the current keymap."
89   `(riece-define-keys-1 (current-local-map) ',plist))
90
91 (defmacro riece-define-keys (keymap &rest plist)
92   "Assign KEYMAP keys from PLIST."
93   `(riece-define-keys-1 ',keymap ',plist))
94
95 (defmacro riece-define-keys-safe (keymap &rest plist)
96   "Assign KEYMAP keys from PLIST without overwriting previous definitions."
97   `(riece-define-keys-1 ',keymap ',plist t))
98
99 (put 'riece-define-keys 'lisp-indent-function 1)
100 (put 'riece-define-keys-safe 'lisp-indent-function 1)
101 (put 'riece-local-set-keys 'lisp-indent-function 1)
102
103 (defun riece-define-keys-1 (keymap plist &optional safe)
104   "Assign KEYMAP keys from PLIST.
105 If optional argument SAFE is nil, overwrite previous definitions."
106   (unless keymap
107     (error "Can't set keys in a null keymap"))
108   (cond
109    ((symbolp keymap)
110     (setq keymap (symbol-value keymap)))
111    ((keymapp keymap))
112    ((listp keymap)
113     (set (car keymap) nil)
114     (define-prefix-command (car keymap))
115     (define-key (symbol-value (nth 2 keymap)) (nth 1 keymap) (car keymap))
116     (setq keymap (symbol-value (car keymap)))))
117   (let (key)
118     (while plist
119       (if (symbolp (setq key (car plist)))
120           (setq key (symbol-value key)))
121       (setq plist (cdr plist))
122       (if (or (not safe)
123               (eq (lookup-key keymap key) 'undefined))
124           (define-key keymap key (car plist))
125         (car plist))
126       (setq plist (cdr plist)))))
127
128 (when t
129   (riece-define-keys riece-dialogue-mode-map
130     "\177" scroll-down
131     [delete] scroll-down
132     [backspace] scroll-down
133     [return] scroll-up
134     " " scroll-up
135     "$" end-of-buffer
136     "/" riece-command-raw
137     ">" end-of-buffer
138     "<" beginning-of-buffer
139     "\C-ta" riece-command-toggle-away
140     "c" riece-command-select-command-buffer
141     "f" riece-command-finger
142     "\C-tf" riece-command-toggle-freeze
143     "\C-to" riece-command-toggle-own-freeze
144     "\C-tu" riece-command-toggle-user-list-buffer-mode
145     "\C-tc" riece-command-toggle-channel-buffer-mode
146     "\C-tC" riece-command-toggle-channel-list-buffer-mode
147     "\C-tl" riece-command-change-layout
148     "i" riece-command-invite
149     "j" riece-command-join
150     "\C-k" riece-command-kick
151     "l" riece-command-list
152     "m" riece-dialogue-enter-message
153     "M" riece-command-change-mode
154     "n" riece-command-change-nickname
155     "\C-n" riece-command-names
156     "o" other-window
157     "O" riece-command-open-server
158     "C" riece-command-close-server
159     "M" riece-command-universal-server-name-argument
160     "q" riece-command-quit
161     "r" riece-command-configure-windows
162     "x" riece-command-copy-region
163     "t" riece-command-topic
164     "w" riece-command-who)
165
166   (riece-define-keys riece-command-mode-map
167     "\r" riece-command-enter-message
168     [(control return)] riece-command-enter-message-as-notice)
169
170   (riece-define-keys (riece-command-map "\C-c" riece-command-mode-map)
171     "\177" riece-command-scroll-down
172     [delete] riece-command-scroll-down
173     [backspace] riece-command-scroll-down
174     " " riece-command-scroll-up
175     "$" riece-command-end-of-buffer
176     ">" riece-command-next-channel
177     "<" riece-command-previous-channel
178     "\C-j" riece-command-next-channel
179     "\C-n" riece-command-names
180     "l" riece-command-list
181     "\C-m" riece-command-change-mode
182     "o" riece-command-set-operators
183     "\C-p" riece-command-part
184     "r" riece-command-configure-windows
185     "v" riece-command-set-speakers)
186   (set-keymap-parent riece-command-map riece-dialogue-mode-map)
187
188   (riece-define-keys riece-user-list-mode-map
189     "o" riece-command-set-operators
190     "v" riece-command-set-voices
191     "f" riece-command-finger
192     " " riece-command-nick-scroll-up
193     "\177" riece-command-nick-scroll-down
194     [delete] riece-command-nick-scroll-down
195     [backspace] riece-command-nick-scroll-down
196     "c" riece-command-select-command-buffer)
197
198   (riece-define-keys riece-channel-list-mode-map
199     ">" riece-command-next-channel
200     "<" riece-command-previous-channel
201     "o" other-window
202     "c" riece-command-select-command-buffer)
203
204   (riece-define-keys-1 riece-dialogue-mode-map riece-select-keys)
205   (riece-define-keys-1 riece-channel-list-mode-map riece-select-keys))
206
207 (defun riece-read-variables-files (&optional file)
208   "Read variables FILEs."
209   (or (file-directory-p riece-directory)
210       (make-directory riece-directory))
211   (let ((files (if file
212                    (setq riece-variables-file file
213                          riece-variables-files (list file))
214                  riece-variables-files)))
215     (while files
216       (condition-case nil
217           (load (expand-file-name (car files)))
218         (file-error nil))
219       (setq files (cdr files)))))
220
221 (defvar print-quoted)
222 (defvar print-escape-multibyte)
223 (defun riece-save-variables-files ()
224   "Save current settings to `riece-variables-file'."
225   (with-temp-file riece-saved-variables-file
226     (let ((print-quoted t)
227           (print-readably t)
228           print-escape-multibyte
229           print-level
230           print-length
231           (variables riece-saved-forms))
232       (while variables
233         (prin1 `(setq ,(car variables)
234                       ',(symbol-value (car variables)))
235                (current-buffer))
236         (insert "\n")
237         (setq variables (cdr variables)))))
238   (setq riece-save-variables-are-dirty nil))
239
240 ;;;###autoload
241 (defun riece (&optional confirm)
242   "Connect to the IRC server and start chatting.
243 If optional argument CONFIRM is non-nil, ask which IRC server to connect."
244   (interactive "P")
245   (riece-read-variables-files (if noninteractive
246                                   (car command-line-args-left)))
247   (riece-insinuate-addons riece-addons)
248   (run-hooks 'riece-after-load-startup-hook)
249   (if (riece-server-opened)
250       (error "Already running"))
251   (if (or confirm (null riece-server))
252       (setq riece-server (completing-read "Server: " riece-server-alist)))
253   (if (stringp riece-server)
254       (setq riece-server (riece-server-name-to-server riece-server)))
255   (riece-create-buffers)
256   (switch-to-buffer riece-command-buffer)
257   (setq riece-channel-history (make-ring riece-channel-history-length))
258   (riece-redisplay-buffers)
259   (riece-open-server riece-server "")
260   (run-hooks 'riece-startup-hook)
261   (message "%s" (substitute-command-keys "Type \\[describe-mode] for help")))
262
263 (defun riece-exit ()
264   (if riece-save-variables-are-dirty
265       (riece-save-variables-files))
266   (while riece-buffer-list
267     (if (and (get-buffer (car riece-buffer-list))
268              (buffer-live-p (car riece-buffer-list)))
269         (funcall riece-buffer-dispose-function (car riece-buffer-list)))
270     (setq riece-buffer-list (cdr riece-buffer-list)))
271   (setq riece-server nil
272         riece-current-channels nil
273         riece-current-channel nil
274         riece-user-indicator nil
275         riece-channel-indicator "None"
276         riece-channel-list-indicator "No channel"
277         riece-away-indicator "-"
278         riece-operator-indicator "-"
279         riece-freeze-indicator "-"
280         riece-channel-history nil)
281   (delete-other-windows)
282   (run-hooks 'riece-exit-hook))
283
284 (defun riece-command-mode ()
285   "Major mode for Riece.  Normal edit function are available.
286 Typing Return or Linefeed enters the current line in the dialogue.
287 The following special commands are available:
288 For a list of the generic commands type \\[riece-command-generic] ? RET.
289 \\{riece-command-mode-map}"
290   (interactive)
291   (kill-all-local-variables)
292
293   (setq riece-away-indicator "-"
294         riece-operator-indicator "-"
295         major-mode 'riece-command-mode
296         mode-name "Commands"
297         mode-line-buffer-identification
298         (riece-mode-line-buffer-identification
299          '("Riece: "
300            riece-away-indicator
301            riece-operator-indicator
302            riece-freeze-indicator
303            " "
304            riece-user-indicator
305            " "
306            riece-short-channel-indicator)))
307   (riece-simplify-mode-line-format)
308   (use-local-map riece-command-mode-map)
309
310   (unless riece-command-mode-syntax-table
311     (setq riece-command-mode-syntax-table
312           (copy-syntax-table (syntax-table)))
313     (set-syntax-table riece-command-mode-syntax-table)
314     (mapcar
315      (lambda (c) (modify-syntax-entry c "w"))
316      "^[]{}'`"))
317
318   (run-hooks 'riece-command-mode-hook))
319   
320 (defun riece-dialogue-mode ()
321   "Major mode for displaying the IRC dialogue.
322 All normal editing commands are turned off.
323 Instead, these commands are available:
324 \\{riece-dialogue-mode-map}"
325   (kill-all-local-variables)
326   (make-local-variable 'riece-freeze)
327   (make-local-variable 'tab-stop-list)
328   (setq riece-freeze riece-default-freeze
329         riece-away-indicator "-"
330         riece-operator-indicator "-"
331         major-mode 'riece-dialogue-mode
332         mode-name "Dialogue"
333         mode-line-buffer-identification
334         (riece-mode-line-buffer-identification
335          '("Riece: "
336            riece-away-indicator
337            riece-operator-indicator
338            riece-freeze-indicator
339            " "
340            riece-channel-list-indicator " "))
341         buffer-read-only t
342         tab-stop-list riece-tab-stop-list)
343   (riece-simplify-mode-line-format)
344   (use-local-map riece-dialogue-mode-map)
345   (buffer-disable-undo)
346   (run-hooks 'riece-dialogue-mode-hook))
347
348 (define-derived-mode riece-others-mode riece-dialogue-mode
349   "Others"
350   "Major mode for displaying the IRC others message except current channel.
351 All normal editing commands are turned off.
352 Instead, these commands are available:
353 \\{riece-others-mode-map}")
354
355 (define-derived-mode riece-channel-mode riece-dialogue-mode
356   "Channel"
357   "Major mode for displaying the IRC current channel buffer.
358 All normal editing commands are turned off.
359 Instead, these commands are available:
360 \\{riece-channel-mode-map}"
361   (setq mode-line-buffer-identification
362         (riece-mode-line-buffer-identification
363          '("Riece: "
364            riece-away-indicator
365            riece-operator-indicator
366            riece-freeze-indicator
367            " "
368            riece-channel-indicator))))
369
370 (defun riece-channel-list-mode ()
371   "Major mode for displaying channel list.
372 All normal editing commands are turned off."
373   (kill-all-local-variables)
374   (buffer-disable-undo)
375   (make-local-variable 'riece-redisplay-buffer)
376   (setq major-mode 'riece-channel-list-mode
377         mode-name "Channels"
378         mode-line-buffer-identification
379         (riece-mode-line-buffer-identification '("Riece: "))
380         truncate-lines t
381         buffer-read-only t)
382   (use-local-map riece-channel-list-mode-map)
383   (run-hooks 'riece-channel-list-mode-hook))
384
385 (defun riece-user-list-mode ()
386   "Major mode for displaying members in the IRC current channel buffer.
387 All normal editing commands are turned off.
388 Instead, these commands are available:
389 \\{riece-user-list-mode-map}"
390   (kill-all-local-variables)
391   (buffer-disable-undo)
392   (make-local-variable 'riece-redisplay-buffer)
393   (setq major-mode 'riece-user-list-mode
394         mode-name "User list"
395         mode-line-buffer-identification
396         (riece-mode-line-buffer-identification
397          '("Riece: " riece-channel-indicator " "))
398         truncate-lines t
399         buffer-read-only t)
400   (if (boundp 'transient-mark-mode)
401       (set (make-local-variable 'transient-mark-mode) t))
402   (use-local-map riece-user-list-mode-map)
403   (run-hooks 'riece-user-list-mode-hook))
404
405 (defun riece-create-buffers ()
406   (let ((alist riece-buffer-mode-alist))
407     (while alist
408       (save-excursion
409         (set-buffer (riece-get-buffer-create
410                      (symbol-value (car (car alist)))))
411         (unless (or (null (cdr (car alist)))
412                     (eq major-mode (cdr (car alist))))
413           (funcall (cdr (car alist))))
414         (setq alist (cdr alist))))))
415
416 (defun riece-load-and-build-addon-dependencies (addons)
417   (let ((load-path (cons riece-addon-directory load-path))
418         dependencies)
419     (while addons
420       (require (car addons))            ;error will be reported here
421       (let* ((requires
422               (funcall (or (intern-soft
423                             (concat (symbol-name (car addons)) "-requires"))
424                            #'ignore)))
425              (pointer requires)
426              entry)
427         ;; Increment succs' pred count.
428         (if (setq entry (assq (car addons) dependencies))
429             (setcar (cdr entry) (+ (length requires) (nth 1 entry)))
430           (setq dependencies (cons (list (car addons) (length requires))
431                                    dependencies)))
432         ;; Merge pred's succs.
433         (while pointer
434           (if (setq entry (assq (car pointer) dependencies))
435               (setcdr (cdr entry)
436                       (cons (car addons) (nthcdr 2 entry)))
437             (setq dependencies (cons (list (car pointer) 0 (car addons))
438                                      dependencies)))
439           (setq pointer (cdr pointer))))
440       (setq addons (cdr addons)))
441     dependencies))
442
443 (defun riece-insinuate-addons (addons)
444   (let ((pointer addons)
445         dependencies queue)
446     ;; Uniquify, first.
447     (while pointer
448       (if (memq (car pointer) (cdr pointer))
449           (setcar pointer nil))
450       (setq pointer (cdr pointer)))
451     (setq dependencies (riece-load-and-build-addon-dependencies
452                         (delq nil addons))
453           pointer dependencies)
454     ;; Sort them.
455     (while pointer
456       (if (zerop (nth 1 (car pointer)))
457           (setq dependencies (delq (car pointer) dependencies)
458                 queue (cons (car pointer) queue)))
459       (setq pointer (cdr pointer)))
460     (setq addons nil)
461     (while queue
462       (setq addons (cons (car (car queue)) addons)
463             pointer (nthcdr 2 (car queue)))
464       (while pointer
465         (let* ((entry (assq (car pointer) dependencies))
466                (count (1- (nth 1 entry))))
467           (if (zerop count)
468               (progn
469                 (setq dependencies (delq entry dependencies)
470                       queue (nconc queue (list entry))))
471             (setcar (cdr entry) count)))
472         (setq pointer (cdr pointer)))
473       (setq queue (cdr queue)))
474     (if dependencies
475         (error "Circular add-on dependency found"))
476     (while addons
477       (require (car addons))            ;implicit dependency
478       (funcall (intern (concat (symbol-name (car addons)) "-insinuate")))
479       (setq addons (cdr addons)))))
480
481 (provide 'riece)
482
483 ;;; riece.el ends here