* riece.el (riece-create-buffers): Suppress byte-compile
[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., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
24
25 ;;; Code:
26
27 (require 'riece-display)
28 (require 'riece-server)
29 (require 'riece-compat)
30 (require 'riece-commands)
31 (require 'riece-addon)
32 (require 'riece-signal)
33
34 (defvar riece-channel-list-mode-map (make-sparse-keymap))
35 (defvar riece-user-list-mode-map (make-sparse-keymap))
36
37 (defvar riece-dialogue-mode-map
38   (let ((keymap (make-keymap)))
39     (suppress-keymap keymap 'nodigit)
40     keymap))
41
42 (defvar riece-command-mode-map (make-keymap))
43 (defvar riece-command-map (make-sparse-keymap))
44
45 (defvar riece-command-mode-syntax-table nil)
46
47 (put 'riece-command-mode 'mode-class 'special)
48 (put 'riece-dialogue-mode 'mode-class 'special)
49 (put 'riece-others-mode 'derived-mode-parent 'riece-dialogue-mode)
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
54 (defvar riece-buffer-alist
55   '((riece-command-buffer "*Command*" riece-command-mode)
56     (riece-dialogue-buffer "*Dialogue*" riece-dialogue-mode)
57     (riece-others-buffer "*Others*" riece-others-mode)
58     (riece-channel-list-buffer "*Channels*" riece-channel-list-mode)
59     (riece-user-list-buffer " *Users*" riece-user-list-mode)
60     (riece-temp-buffer " *Temp*")
61     (riece-debug-buffer "*Debug*")))
62
63 (defvar riece-select-keys
64   `("#" riece-command-switch-to-channel-by-number
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     ,(concat riece-command-prefix "1")
76     riece-command-switch-to-channel-by-number-11
77     ,(concat riece-command-prefix "2")
78     riece-command-switch-to-channel-by-number-12
79     ,(concat riece-command-prefix "3")
80     riece-command-switch-to-channel-by-number-13
81     ,(concat riece-command-prefix "4")
82     riece-command-switch-to-channel-by-number-14
83     ,(concat riece-command-prefix "5")
84     riece-command-switch-to-channel-by-number-15
85     ,(concat riece-command-prefix "6")
86     riece-command-switch-to-channel-by-number-16
87     ,(concat riece-command-prefix "7")
88     riece-command-switch-to-channel-by-number-17
89     ,(concat riece-command-prefix "8")
90     riece-command-switch-to-channel-by-number-18
91     ,(concat riece-command-prefix "9")
92     riece-command-switch-to-channel-by-number-19
93     ,(concat riece-command-prefix "0")
94     riece-command-switch-to-channel-by-number-20))
95
96 ;;; Keymap macros. -- borrowed from `gnus-util.el'.
97 (defmacro riece-local-set-keys (&rest plist)
98   "Set the keys in PLIST in the current keymap."
99   `(riece-define-keys-1 (current-local-map) ',plist))
100
101 (defmacro riece-define-keys (keymap &rest plist)
102   "Assign KEYMAP keys from PLIST."
103   `(riece-define-keys-1 ',keymap ',plist))
104
105 (defmacro riece-define-keys-safe (keymap &rest plist)
106   "Assign KEYMAP keys from PLIST without overwriting previous definitions."
107   `(riece-define-keys-1 ',keymap ',plist t))
108
109 (put 'riece-define-keys 'lisp-indent-function 1)
110 (put 'riece-define-keys-safe 'lisp-indent-function 1)
111 (put 'riece-local-set-keys 'lisp-indent-function 1)
112
113 (defun riece-define-keys-1 (keymap plist &optional safe)
114   "Assign KEYMAP keys from PLIST.
115 If optional argument SAFE is nil, overwrite previous definitions."
116   (unless keymap
117     (error "Can't set keys in a null keymap"))
118   (cond
119    ((symbolp keymap)
120     (setq keymap (symbol-value keymap)))
121    ((keymapp keymap))
122    ((listp keymap)
123     (set (car keymap) nil)
124     (define-prefix-command (car keymap))
125     (define-key (symbol-value (nth 2 keymap))
126       (if (symbolp (nth 1 keymap))
127           (symbol-value (nth 1 keymap))
128         (nth 1 keymap))
129       (car keymap))
130     (setq keymap (symbol-value (car keymap)))))
131   (let (key)
132     (while plist
133       (if (symbolp (setq key (car plist)))
134           (setq key (symbol-value key)))
135       (setq plist (cdr plist))
136       (if (or (not safe)
137               (eq (lookup-key keymap key) 'undefined))
138           (define-key keymap key (car plist))
139         (car plist))
140       (setq plist (cdr plist)))))
141
142 (when t
143   (riece-define-keys riece-dialogue-mode-map
144     "\177" scroll-down
145     [delete] scroll-down
146     [backspace] scroll-down
147     [return] scroll-up
148     " " scroll-up
149     [home] beginning-of-buffer
150     "$" end-of-buffer
151     [end] end-of-buffer
152     "/" riece-command-raw
153     ">" end-of-buffer
154     "<" beginning-of-buffer
155     "^" riece-command-list-addons
156     "\C-ta" riece-command-toggle-away
157     "c" riece-command-select-command-buffer
158     "f" riece-command-finger
159     "\C-tf" riece-command-toggle-freeze
160     "\C-to" riece-command-toggle-own-freeze
161     "\C-tO" riece-command-toggle-others-buffer-mode
162     "\C-tu" riece-command-toggle-user-list-buffer-mode
163     "\C-tc" riece-command-toggle-channel-buffer-mode
164     "\C-tC" riece-command-toggle-channel-list-buffer-mode
165     "\C-tl" riece-command-change-layout
166     "i" riece-command-invite
167     "j" riece-command-join
168     "\C-k" riece-command-kick
169     "l" riece-command-list
170     "M" riece-command-change-mode
171     "n" riece-command-change-nickname
172     "N" riece-command-names
173     "o" other-window
174     "O" riece-command-open-server
175     "C" riece-command-close-server
176     "M" riece-command-universal-server-name-argument
177     "p" riece-command-enter-message-to-user
178     "q" riece-command-quit
179     "r" riece-command-configure-windows
180     "s" riece-command-save-variables
181     "x" riece-command-copy-region
182     "t" riece-command-topic
183     "w" riece-command-who
184     "z" riece-command-suspend-resume)
185
186   (riece-define-keys riece-command-mode-map
187     "\r" riece-command-enter-message
188     [(control return)] riece-command-enter-message-as-notice
189     [tab] riece-command-complete-user)
190
191   (riece-define-keys (riece-command-map riece-command-prefix
192                                         riece-command-mode-map)
193     "\177" riece-command-scroll-down
194     [delete] riece-command-scroll-down
195     [backspace] riece-command-scroll-down
196     " " riece-command-scroll-up
197     [home] riece-command-beginning-of-buffer
198     "$" riece-command-end-of-buffer
199     [end] riece-command-end-of-buffer
200     ">" riece-command-next-channel
201     "<" riece-command-previous-channel
202     "\C-j" riece-command-next-channel
203     "\C-n" riece-command-names
204     "l" riece-command-list
205     "\C-m" riece-command-change-mode
206     "o" riece-command-set-operators
207     "\C-p" riece-command-part
208     "r" riece-command-configure-windows
209     "v" riece-command-set-speakers
210     "V" riece-version)
211   (set-keymap-parent riece-command-map riece-dialogue-mode-map)
212
213   (riece-define-keys riece-user-list-mode-map
214     "o" riece-command-set-operators
215     "v" riece-command-set-voices
216     "f" riece-command-finger
217     " " riece-command-user-list-scroll-up
218     "\177" riece-command-user-list-scroll-down
219     [delete] riece-command-user-list-scroll-down
220     [backspace] riece-command-user-list-scroll-down
221     "c" riece-command-select-command-buffer)
222
223   (riece-define-keys riece-channel-list-mode-map
224     ">" riece-command-next-channel
225     "<" riece-command-previous-channel
226     "o" other-window
227     "c" riece-command-select-command-buffer)
228
229   (riece-define-keys-1 riece-dialogue-mode-map riece-select-keys)
230   (riece-define-keys-1 riece-channel-list-mode-map riece-select-keys))
231
232 (defun riece-read-variables-files (&optional file)
233   "Read variables FILEs."
234   (or (file-directory-p riece-directory)
235       (make-directory riece-directory))
236   (let ((files (if file
237                    (setq riece-variables-file file
238                          riece-variables-files (list file))
239                  riece-variables-files)))
240     (while files
241       (condition-case nil
242           (load (expand-file-name (car files)))
243         (file-error nil))
244       (setq files (cdr files)))))
245
246 (defvar print-quoted)
247 (defvar print-escape-multibyte)
248 (defun riece-save-variables-files ()
249   "Save current settings to `riece-saved-variables-file'."
250   (message (riece-mcat "Saving %s...") riece-saved-variables-file)
251   (with-temp-file riece-saved-variables-file
252     (insert ";;; This file is generated automatically by " riece-version ".\n"
253             ";;; Do not edit this file!\n\n")
254     (let ((print-quoted t)
255           (print-readably t)
256           print-escape-multibyte
257           print-level
258           print-length
259           (variables riece-saved-forms))
260       (while variables
261         (prin1 `(setq ,(car variables)
262                       ',(symbol-value (car variables)))
263                (current-buffer))
264         (insert "\n")
265         (setq variables (cdr variables)))))
266   (message (riece-mcat "Saving %s...done") riece-saved-variables-file)
267   (setq riece-save-variables-are-dirty nil))
268
269 ;;;###autoload
270 (defun riece (&optional confirm)
271   "Connect to the IRC server and start chatting.
272 If optional argument CONFIRM is non-nil, ask which IRC server to connect."
273   (interactive "P")
274   (riece-read-variables-files (if noninteractive
275                                   (car command-line-args-left)))
276   (run-hooks 'riece-after-load-startup-hook)
277   (if (riece-server-opened)
278       (riece-command-configure-windows)
279     (modify-frame-parameters (selected-frame)
280                              (list (cons 'riece-window-configuration
281                                          (current-window-configuration))))
282     (setq riece-addon-dependencies (riece-resolve-addons
283                                     (copy-sequence riece-addons)))
284     (let ((pointer riece-addon-dependencies))
285       (while pointer
286         (riece-insinuate-addon (car (car pointer)) riece-debug)
287         (setq pointer (cdr pointer))))
288     (if (or confirm (null riece-server))
289         (setq riece-server (completing-read (riece-mcat "Server: ")
290                                             riece-server-alist)))
291     (if (stringp riece-server)
292         (setq riece-server (riece-server-name-to-server riece-server)))
293     (riece-create-buffers)
294     (switch-to-buffer riece-command-buffer)
295     (riece-display-connect-signals)
296     (riece-redisplay-buffers)
297     (riece-open-server riece-server "")
298     ;; If no server process is available, exit.
299     (if (null riece-server-process-alist)
300         (riece-exit)
301       (let ((server-list riece-startup-server-list))
302         (while server-list
303           (riece-command-open-server (car server-list))
304           (setq server-list (cdr server-list))))
305       (let ((channel-list riece-startup-channel-list)
306             server)
307         (while channel-list
308           (setq server (riece-identity-server
309                         (riece-parse-identity (car channel-list))))
310           (unless (riece-server-opened server)
311             (riece-command-open-server server))
312           (setq channel-list (cdr channel-list))))
313       (let ((pointer riece-addon-dependencies))
314         (while pointer
315           (unless (get (car (car pointer)) 'riece-addon-default-disabled)
316             (riece-enable-addon (car (car pointer)) riece-debug))
317           (setq pointer (cdr pointer))))
318       (run-hooks 'riece-startup-hook)
319       (message "%s" (substitute-command-keys
320                      (riece-mcat "Type \\[describe-mode] for help"))))))
321
322 (defun riece-exit ()
323   (if riece-save-variables-are-dirty
324       (riece-save-variables-files))
325   (while riece-buffer-list
326     (if (and (get-buffer (car riece-buffer-list))
327              (buffer-live-p (car riece-buffer-list)))
328         (funcall riece-buffer-dispose-function (car riece-buffer-list)))
329     (setq riece-buffer-list (cdr riece-buffer-list)))
330   (riece-clear-signal-slots)
331   (setq riece-server nil
332         riece-current-channels nil
333         riece-current-channel nil
334         riece-channel-buffer nil
335         riece-channel-buffer-alist nil
336         riece-user-indicator nil
337         riece-long-channel-indicator (riece-mcat "None")
338         riece-channel-list-indicator (riece-mcat "No channel")
339         riece-away-indicator "-"
340         riece-operator-indicator "-"
341         riece-channel-status-indicator "-"
342         riece-freeze-indicator "-")
343   (modify-frame-parameters (selected-frame)
344                            (list (list 'riece-window-configuration)))
345   (delete-other-windows)
346   (run-hooks 'riece-exit-hook))
347
348 (defun riece-command-mode ()
349   "Major mode for Riece.  Normal edit function are available.
350 Typing Return or Linefeed enters the current line in the dialogue.
351 The following special commands are available:
352 For a list of the generic commands type \\[riece-command-generic] ? RET.
353 \\{riece-command-mode-map}"
354   (interactive)
355   (kill-all-local-variables)
356
357   ;; Make `truncate-partial-width-windows' buffer local and set it to
358   ;; nil.  This causes `truncate-lines' to directly control line
359   ;; truncation.
360   (make-local-variable 'truncate-partial-width-windows)
361   (setq truncate-partial-width-windows nil)
362
363   (make-local-variable 'riece-mode-line-buffer-identification)
364   (setq riece-away-indicator "-"
365         riece-operator-indicator "-"
366         riece-channel-status-indicator "-"
367         major-mode 'riece-command-mode
368         mode-name "Command"
369         riece-mode-line-buffer-identification
370         '("Riece: "
371           riece-away-indicator
372           riece-operator-indicator
373           riece-channel-status-indicator
374           " "
375           riece-user-indicator
376           " "
377           riece-channel-indicator)
378         mode-line-buffer-identification
379         (riece-mode-line-buffer-identification
380          riece-mode-line-buffer-identification)
381         truncate-lines nil)
382   (riece-simplify-mode-line-format)
383   (use-local-map riece-command-mode-map)
384
385   (unless riece-command-mode-syntax-table
386     (setq riece-command-mode-syntax-table
387           (copy-syntax-table (syntax-table)))
388     (set-syntax-table riece-command-mode-syntax-table)
389     (let* ((chars "^[]{}'`")
390            (length (length chars))
391            (index 0))
392       (while (< index length)
393         (modify-syntax-entry (aref chars index) "w")
394         (setq index (1+ index)))))
395
396   (run-hooks 'riece-command-mode-hook))
397
398 (defun riece-dialogue-mode ()
399   "Major mode for displaying the IRC dialogue.
400 All normal editing commands are turned off.
401 Instead, these commands are available:
402 \\{riece-dialogue-mode-map}"
403   (kill-all-local-variables)
404   (make-local-variable 'riece-freeze)
405   (make-local-variable 'riece-freeze-indicator)
406
407   ;; Make `truncate-partial-width-windows' buffer local and set it to
408   ;; nil.  This causes `truncate-lines' to directly control line truncation.
409   (make-local-variable 'truncate-partial-width-windows)
410   (setq truncate-partial-width-windows nil)
411
412   (make-local-variable 'riece-mode-line-buffer-identification)
413   (setq riece-freeze riece-default-freeze
414         riece-away-indicator "-"
415         riece-operator-indicator "-"
416         riece-channel-status-indicator "-"
417         major-mode 'riece-dialogue-mode
418         mode-name "Dialogue"
419         riece-mode-line-buffer-identification
420         '("Riece: "
421           riece-away-indicator
422           riece-operator-indicator
423           riece-freeze-indicator
424           riece-channel-status-indicator
425           " "
426           riece-channel-list-indicator " ")
427         mode-line-buffer-identification
428         (riece-mode-line-buffer-identification
429          riece-mode-line-buffer-identification)
430         truncate-lines nil
431         buffer-read-only t)
432   (riece-simplify-mode-line-format)
433   (use-local-map riece-dialogue-mode-map)
434   (buffer-disable-undo)
435   (run-hooks 'riece-dialogue-mode-hook))
436
437 (define-derived-mode riece-others-mode riece-dialogue-mode
438   "Others"
439   "Major mode for displaying the IRC others message except current channel.
440 All normal editing commands are turned off.
441 Instead, these commands are available:
442 \\{riece-others-mode-map}")
443
444 (define-derived-mode riece-channel-mode riece-dialogue-mode
445   "Channel"
446   "Major mode for displaying the IRC current channel buffer.
447 All normal editing commands are turned off.
448 Instead, these commands are available:
449 \\{riece-channel-mode-map}"
450   (make-local-variable 'riece-channel-buffer-window-point)
451   (make-local-variable 'riece-mode-line-buffer-identification)
452   (setq riece-mode-line-buffer-identification
453         '("Riece: "
454           riece-away-indicator
455           riece-operator-indicator
456           riece-freeze-indicator
457           riece-channel-status-indicator
458           " "
459           riece-long-channel-indicator)
460         mode-line-buffer-identification
461         (riece-mode-line-buffer-identification
462          riece-mode-line-buffer-identification)))
463
464 (defun riece-channel-list-mode ()
465   "Major mode for displaying channel list.
466 All normal editing commands are turned off."
467   (kill-all-local-variables)
468   (buffer-disable-undo)
469
470   ;; Make `truncate-partial-width-windows' buffer local and set it to
471   ;; nil.  This causes `truncate-lines' to directly control line truncation.
472   (make-local-variable 'truncate-partial-width-windows)
473   (setq truncate-partial-width-windows nil)
474
475   (make-local-variable 'riece-mode-line-buffer-identification)
476   (setq major-mode 'riece-channel-list-mode
477         mode-name "Channels"
478         riece-mode-line-buffer-identification '("Riece: ")
479         mode-line-buffer-identification
480         (riece-mode-line-buffer-identification
481          riece-mode-line-buffer-identification)
482         truncate-lines t
483         buffer-read-only t)
484   (riece-make-local-hook 'riece-update-buffer-functions)
485   (add-hook 'riece-update-buffer-functions
486             'riece-update-channel-list-buffer nil t)
487   (use-local-map riece-channel-list-mode-map)
488   (run-hooks 'riece-channel-list-mode-hook))
489
490 (defun riece-user-list-mode ()
491   "Major mode for displaying members in the IRC current channel buffer.
492 All normal editing commands are turned off.
493 Instead, these commands are available:
494 \\{riece-user-list-mode-map}"
495   (kill-all-local-variables)
496   (buffer-disable-undo)
497
498   ;; Make `truncate-partial-width-windows' buffer local and set it to
499   ;; nil.  This causes `truncate-lines' to directly control line truncation.
500   (make-local-variable 'truncate-partial-width-windows)
501   (setq truncate-partial-width-windows nil)
502
503   (make-local-variable 'riece-mode-line-buffer-identification)
504   (setq major-mode 'riece-user-list-mode
505         mode-name "Users"
506         riece-mode-line-buffer-identification
507         '("Riece: " riece-long-channel-indicator " ")
508         mode-line-buffer-identification
509         (riece-mode-line-buffer-identification
510          riece-mode-line-buffer-identification)
511         truncate-lines t
512         buffer-read-only t)
513   (if (boundp 'transient-mark-mode)
514       (set (make-local-variable 'transient-mark-mode) t))
515   (riece-make-local-hook 'riece-update-buffer-functions)
516   (add-hook 'riece-update-buffer-functions
517             'riece-update-user-list-buffer nil t)
518   (use-local-map riece-user-list-mode-map)
519   (run-hooks 'riece-user-list-mode-hook))
520
521 (defun riece-create-buffers ()
522   (let ((alist riece-buffer-alist))
523     (while alist
524       (with-current-buffer (apply #'riece-get-buffer-create
525                                   (cdr (car alist)))
526         (set (car (car alist)) (current-buffer))
527         (unless (or (null (nth 2 (car alist)))
528                     (eq major-mode (nth 2 (car alist))))
529           (funcall (nth 2 (car alist))))
530         (setq alist (cdr alist))))))
531
532 (defun riece-submit-bug-report ()
533   "Submit via mail a bug report on Riece."
534   (interactive)
535   (browse-url "https://savannah.nongnu.org/bugs/?group=riece"))
536
537 (provide 'riece)
538
539 ;;; riece.el ends here