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