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