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