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 (if (featurep 'xemacs)
  28     (require 'riece-xemacs)
  29   (require 'riece-emacs))
  30
  31 (require 'riece-filter)
  32 (require 'riece-display)
  33 (require 'riece-server)
  34 (require 'riece-compat)
  35 (require 'riece-commands)
  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-channel-list-mode 'mode-class 'special)
  53 (put 'riece-user-list-mode 'mode-class 'special)
  54 (put 'riece-channel-mode 'derived-mode-parent 'riece-dialogue-mode)
  55 (put 'riece-others-mode 'derived-mode-parent 'riece-dialogue-mode)
  56
  57 (defvar riece-buffer-mode-alist
  58   '((riece-dialogue-buffer . riece-dialogue-mode)
  59     (riece-others-buffer . riece-others-mode)
  60     (riece-user-list-buffer . riece-user-list-mode)
  61     (riece-channel-list-buffer . riece-channel-list-mode)
  62     (riece-private-buffer . riece-dialogue-mode)
  63     (riece-wallops-buffer)))
  64
  65 (defvar riece-select-keys
  66   '("1" riece-command-switch-to-channel-by-number-1
  67     "2" riece-command-switch-to-channel-by-number-2
  68     "3" riece-command-switch-to-channel-by-number-3
  69     "4" riece-command-switch-to-channel-by-number-4
  70     "5" riece-command-switch-to-channel-by-number-5
  71     "6" riece-command-switch-to-channel-by-number-6
  72     "7" riece-command-switch-to-channel-by-number-7
  73     "8" riece-command-switch-to-channel-by-number-8
  74     "9" riece-command-switch-to-channel-by-number-9
  75     "0" riece-command-switch-to-channel-by-number-10
  76     "\C-c1" riece-command-switch-to-channel-by-number-11
  77     "\C-c2" riece-command-switch-to-channel-by-number-12
  78     "\C-c3" riece-command-switch-to-channel-by-number-13
  79     "\C-c4" riece-command-switch-to-channel-by-number-14
  80     "\C-c5" riece-command-switch-to-channel-by-number-15
  81     "\C-c6" riece-command-switch-to-channel-by-number-16
  82     "\C-c7" riece-command-switch-to-channel-by-number-17
  83     "\C-c8" riece-command-switch-to-channel-by-number-18
  84     "\C-c9" riece-command-switch-to-channel-by-number-19
  85     "\C-c0" riece-command-switch-to-channel-by-number-20))
  86
  87 ;;; Keymap macros. -- borrowed from `gnus-util.el'.
  88 (defmacro riece-local-set-keys (&rest plist)
  89   "Set the keys in PLIST in the current keymap."
  90   `(riece-define-keys-1 (current-local-map) ',plist))
  91
  92 (defmacro riece-define-keys (keymap &rest plist)
  93   "Assign KEYMAP keys from PLIST."
  94   `(riece-define-keys-1 ',keymap ',plist))
  95
  96 (defmacro riece-define-keys-safe (keymap &rest plist)
  97   "Assign KEYMAP keys from PLIST without overwriting previous definitions."
  98   `(riece-define-keys-1 ',keymap ',plist t))
  99
 100 (put 'riece-define-keys 'lisp-indent-function 1)
 101 (put 'riece-define-keys-safe 'lisp-indent-function 1)
 102 (put 'riece-local-set-keys 'lisp-indent-function 1)
 103
 104 (defun riece-define-keys-1 (keymap plist &optional safe)
 105   "Assign KEYMAP keys from PLIST.
 106 If optional argument SAFE is nil, overwrite previous definitions."
 107   (unless keymap
 108     (error "Can't set keys in a null keymap"))
 109   (cond
 110    ((symbolp keymap)
 111     (setq keymap (symbol-value keymap)))
 112    ((keymapp keymap))
 113    ((listp keymap)
 114     (set (car keymap) nil)
 115     (define-prefix-command (car keymap))
 116     (define-key (symbol-value (nth 2 keymap)) (nth 1 keymap) (car keymap))
 117     (setq keymap (symbol-value (car keymap)))))
 118   (let (key)
 119     (while plist
 120       (if (symbolp (setq key (car plist)))
 121           (setq key (symbol-value key)))
 122       (setq plist (cdr plist))
 123       (if (or (not safe)
 124               (eq (lookup-key keymap key) 'undefined))
 125           (define-key keymap key (car plist))
 126         (car plist))
 127       (setq plist (cdr plist)))))
 128
 129 (when t
 130   (riece-define-keys riece-dialogue-mode-map
 131     "\177" scroll-down
 132     [delete] scroll-down
 133     [backspace] scroll-down
 134     [return] scroll-up
 135     " " scroll-up
 136     "$" end-of-buffer
 137     "/" riece-command-raw
 138     ">" end-of-buffer
 139     "<" beginning-of-buffer
 140     "\C-ta" riece-command-toggle-away
 141     "c" riece-command-select-command-buffer
 142     "f" riece-command-finger
 143     "\C-tf" riece-command-toggle-freeze
 144     "\C-to" riece-command-toggle-own-freeze
 145     "\C-tu" riece-command-toggle-user-list-buffer-mode
 146     "\C-tc" riece-command-toggle-channel-buffer-mode
 147     "\C-tC" riece-command-toggle-channel-list-buffer-mode
 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 If already connected, just pop up the windows."
 245   (interactive "P")
 246   (riece-read-variables-files (if noninteractive
 247                                   (car command-line-args-left)))
 248   (riece-insinuate-addons riece-addons)
 249   (run-hooks 'riece-after-load-startup-hook)
 250   (if (riece-server-opened)
 251       (riece-configure-windows)
 252     (switch-to-buffer (riece-get-buffer-create riece-command-buffer))
 253     (unless (eq major-mode 'riece-command-mode)
 254       (riece-command-mode))
 255     (if (or confirm (null riece-server))
 256         (setq riece-server (completing-read "Server: " riece-server-alist)))
 257     (if (stringp riece-server)
 258         (setq riece-server (riece-server-name-to-server riece-server)))
 259     (riece-create-buffers)
 260     (riece-configure-windows)
 261     (riece-open-server riece-server "")
 262     (run-hooks 'riece-startup-hook)
 263     (message "%s" (substitute-command-keys
 264                    "Type \\[describe-mode] for help"))))
 265
 266 (defun riece-exit ()
 267   (setq riece-server nil)
 268   (if riece-save-variables-are-dirty
 269       (riece-save-variables-files))
 270   (riece-clear-system)
 271   (run-hooks 'riece-exit-hook))
 272
 273 (defun riece-command-mode ()
 274   "Major mode for Riece.  Normal edit function are available.
 275 Typing Return or Linefeed enters the current line in the dialogue.
 276 The following special commands are available:
 277 For a list of the generic commands type \\[riece-command-generic] ? RET.
 278 \\{riece-command-mode-map}"
 279   (interactive)
 280   (kill-all-local-variables)
 281
 282   (setq riece-away-indicator "-"
 283         riece-operator-indicator "-"
 284         major-mode 'riece-command-mode
 285         mode-name "Commands"
 286         mode-line-buffer-identification
 287         (riece-mode-line-buffer-identification
 288          '("Riece: "
 289            riece-away-indicator
 290            riece-operator-indicator
 291            riece-freeze-indicator
 292            " "
 293            riece-user-indicator
 294            " "
 295            riece-short-channel-indicator)))
 296   (riece-simplify-mode-line-format)
 297   (use-local-map riece-command-mode-map)
 298
 299   (unless riece-command-mode-syntax-table
 300     (setq riece-command-mode-syntax-table
 301           (copy-syntax-table (syntax-table)))
 302     (set-syntax-table riece-command-mode-syntax-table)
 303     (mapcar
 304      (lambda (c) (modify-syntax-entry c "w"))
 305      "^[]{}'`"))
 306
 307   (run-hooks 'riece-command-mode-hook))
 308
 309 (defun riece-dialogue-mode ()
 310   "Major mode for displaying the IRC dialogue.
 311 All normal editing commands are turned off.
 312 Instead, these commands are available:
 313 \\{riece-dialogue-mode-map}"
 314   (kill-all-local-variables)
 315
 316   (make-local-variable 'riece-freeze)
 317   (make-local-variable 'tab-stop-list)
 318
 319   (setq riece-freeze riece-default-freeze
 320         riece-away-indicator "-"
 321         riece-operator-indicator "-"
 322         major-mode 'riece-dialogue-mode
 323         mode-name "Dialogue"
 324         mode-line-buffer-identification
 325         (riece-mode-line-buffer-identification
 326          '("Riece: "
 327            riece-away-indicator
 328            riece-operator-indicator
 329            riece-freeze-indicator
 330            " "
 331            riece-channel-list-indicator " "))
 332         buffer-read-only t
 333         tab-stop-list riece-tab-stop-list)
 334   (riece-simplify-mode-line-format)
 335   (use-local-map riece-dialogue-mode-map)
 336   (buffer-disable-undo)
 337   (run-hooks 'riece-dialogue-mode-hook))
 338
 339 (define-derived-mode riece-others-mode riece-dialogue-mode
 340   "Others"
 341   "Major mode for displaying the IRC others message except current channel.
 342 All normal editing commands are turned off.
 343 Instead, these commands are available:
 344 \\{riece-others-mode-map}")
 345
 346 (define-derived-mode riece-channel-mode riece-dialogue-mode
 347   "Channel"
 348   "Major mode for displaying the IRC current channel buffer.
 349 All normal editing commands are turned off.
 350 Instead, these commands are available:
 351 \\{riece-channel-mode-map}"
 352   (setq mode-line-buffer-identification
 353         (riece-mode-line-buffer-identification
 354          '("Riece: "
 355            riece-away-indicator
 356            riece-operator-indicator
 357            riece-freeze-indicator
 358            " "
 359            riece-channel-indicator))))
 360
 361 (defun riece-channel-list-mode ()
 362   "Major mode for displaying channel list.
 363 All normal editing commands are turned off."
 364   (kill-all-local-variables)
 365   (buffer-disable-undo)
 366   (setq major-mode 'riece-channel-list-mode
 367         mode-name "Channels"
 368         mode-line-buffer-identification
 369         (riece-mode-line-buffer-identification '("Riece: "))
 370         truncate-lines t
 371         buffer-read-only t)
 372   (use-local-map riece-channel-list-mode-map)
 373   (run-hooks 'riece-channel-list-mode-hook))
 374
 375 (defun riece-user-list-mode ()
 376   "Major mode for displaying members in the IRC current channel buffer.
 377 All normal editing commands are turned off.
 378 Instead, these commands are available:
 379 \\{riece-user-list-mode-map}"
 380   (kill-all-local-variables)
 381   (buffer-disable-undo)
 382   (setq major-mode 'riece-user-list-mode
 383         mode-name "User list"
 384         mode-line-buffer-identification
 385         (riece-mode-line-buffer-identification
 386          '("Riece: " riece-channel-indicator " "))
 387         truncate-lines t
 388         buffer-read-only t)
 389   (if (boundp 'transient-mark-mode)
 390       (set (make-local-variable 'transient-mark-mode) t))
 391   (use-local-map riece-user-list-mode-map)
 392   (run-hooks 'riece-user-list-mode-hook))
 393
 394 (defun riece-create-buffers ()
 395   (let ((alist riece-buffer-mode-alist))
 396     (while alist
 397       (save-excursion
 398         (set-buffer (riece-get-buffer-create
 399                      (symbol-value (car (car alist)))))
 400         (unless (or (null (cdr (car alist)))
 401                     (eq major-mode (cdr (car alist))))
 402           (funcall (cdr (car alist))))
 403         (setq alist (cdr alist))))))
 404
 405 (defun riece-load-and-build-addon-dependencies (addons)
 406   (let ((load-path (cons riece-addon-directory load-path))
 407         dependencies)
 408     (while addons
 409       (require (car addons))            ;error will be reported here
 410       (let* ((requires
 411               (funcall (or (intern-soft
 412                             (concat (symbol-name (car addons)) "-requires"))
 413                            #'ignore)))
 414              (pointer requires)
 415              entry)
 416         ;; Increment succs' pred count.
 417         (if (setq entry (assq (car addons) dependencies))
 418             (setcar (cdr entry) (+ (length requires) (nth 1 entry)))
 419           (setq dependencies (cons (list (car addons) (length requires))
 420                                    dependencies)))
 421         ;; Merge pred's succs.
 422         (while pointer
 423           (if (setq entry (assq (car pointer) dependencies))
 424               (setcdr (cdr entry)
 425                       (cons (car addons) (nthcdr 2 entry)))
 426             (setq dependencies (cons (list (car pointer) 0 (car addons))
 427                                      dependencies)))
 428           (setq pointer (cdr pointer))))
 429       (setq addons (cdr addons)))
 430     dependencies))
 431
 432 (defun riece-insinuate-addons (addons)
 433   (let ((pointer addons)
 434         dependencies queue)
 435     ;; Uniquify, first.
 436     (while pointer
 437       (if (memq (car pointer) (cdr pointer))
 438           (setcar pointer nil))
 439       (setq pointer (cdr pointer)))
 440     (setq dependencies (riece-load-and-build-addon-dependencies
 441                         (delq nil addons))
 442           pointer dependencies)
 443     ;; Sort them.
 444     (while pointer
 445       (if (zerop (nth 1 (car pointer)))
 446           (setq dependencies (delq (car pointer) dependencies)
 447                 queue (cons (car pointer) queue)))
 448       (setq pointer (cdr pointer)))
 449     (setq addons nil)
 450     (while queue
 451       (setq addons (cons (car (car queue)) addons)
 452             pointer (nthcdr 2 (car queue)))
 453       (while pointer
 454         (let* ((entry (assq (car pointer) dependencies))
 455                (count (1- (nth 1 entry))))
 456           (if (zerop count)
 457               (progn
 458                 (setq dependencies (delq entry dependencies)
 459                       queue (nconc queue (list entry))))
 460             (setcar (cdr entry) count)))
 461         (setq pointer (cdr pointer)))
 462       (setq queue (cdr queue)))
 463     (if dependencies
 464         (error "Circular add-on dependency found"))
 465     (while addons
 466       (require (car addons))            ;implicit dependency
 467       (funcall (intern (concat (symbol-name (car addons)) "-insinuate")))
 468       (setq addons (cdr addons)))))
 469
 470 (provide 'riece)
 471
 472 ;;; riece.el ends here