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   (if riece-save-variables-are-dirty
 262       (riece-save-variables-files))
 263   (while riece-buffer-list
 264     (if (and (get-buffer (car riece-buffer-list))
 265              (buffer-live-p (car riece-buffer-list)))
 266         (funcall riece-buffer-dispose-function (car riece-buffer-list)))
 267     (setq riece-buffer-list (cdr riece-buffer-list)))
 268   (setq riece-server nil
 269         riece-current-channels nil
 270         riece-current-channel nil
 271         riece-user-indicator nil
 272         riece-channel-indicator "None"
 273         riece-channel-list-indicator "No channel"
 274         riece-away-indicator "-"
 275         riece-operator-indicator "-"
 276         riece-freeze-indicator "-"
 277         riece-channel-history nil)
 278   (delete-other-windows)
 279   (run-hooks 'riece-exit-hook))
 280
 281 (defun riece-command-mode ()
 282   "Major mode for Riece.  Normal edit function are available.
 283 Typing Return or Linefeed enters the current line in the dialogue.
 284 The following special commands are available:
 285 For a list of the generic commands type \\[riece-command-generic] ? RET.
 286 \\{riece-command-mode-map}"
 287   (interactive)
 288   (kill-all-local-variables)
 289
 290   (setq riece-away-indicator "-"
 291         riece-operator-indicator "-"
 292         major-mode 'riece-command-mode
 293         mode-name "Commands"
 294         mode-line-buffer-identification
 295         (riece-mode-line-buffer-identification
 296          '("Riece: "
 297            riece-away-indicator
 298            riece-operator-indicator
 299            riece-freeze-indicator
 300            " "
 301            riece-user-indicator
 302            " "
 303            riece-short-channel-indicator)))
 304   (riece-simplify-mode-line-format)
 305   (use-local-map riece-command-mode-map)
 306
 307   (unless riece-command-mode-syntax-table
 308     (setq riece-command-mode-syntax-table
 309           (copy-syntax-table (syntax-table)))
 310     (set-syntax-table riece-command-mode-syntax-table)
 311     (mapcar
 312      (lambda (c) (modify-syntax-entry c "w"))
 313      "^[]{}'`"))
 314
 315   (run-hooks 'riece-command-mode-hook))
 316
 317 (defun riece-dialogue-mode ()
 318   "Major mode for displaying the IRC dialogue.
 319 All normal editing commands are turned off.
 320 Instead, these commands are available:
 321 \\{riece-dialogue-mode-map}"
 322   (kill-all-local-variables)
 323   (make-local-variable 'riece-freeze)
 324   (make-local-variable 'tab-stop-list)
 325   (setq riece-freeze riece-default-freeze
 326         riece-away-indicator "-"
 327         riece-operator-indicator "-"
 328         major-mode 'riece-dialogue-mode
 329         mode-name "Dialogue"
 330         mode-line-buffer-identification
 331         (riece-mode-line-buffer-identification
 332          '("Riece: "
 333            riece-away-indicator
 334            riece-operator-indicator
 335            riece-freeze-indicator
 336            " "
 337            riece-channel-list-indicator " "))
 338         buffer-read-only t
 339         tab-stop-list riece-tab-stop-list)
 340   (riece-simplify-mode-line-format)
 341   (use-local-map riece-dialogue-mode-map)
 342   (buffer-disable-undo)
 343   (run-hooks 'riece-dialogue-mode-hook))
 344
 345 (define-derived-mode riece-others-mode riece-dialogue-mode
 346   "Others"
 347   "Major mode for displaying the IRC others message except current channel.
 348 All normal editing commands are turned off.
 349 Instead, these commands are available:
 350 \\{riece-others-mode-map}")
 351
 352 (define-derived-mode riece-channel-mode riece-dialogue-mode
 353   "Channel"
 354   "Major mode for displaying the IRC current channel buffer.
 355 All normal editing commands are turned off.
 356 Instead, these commands are available:
 357 \\{riece-channel-mode-map}"
 358   (setq mode-line-buffer-identification
 359         (riece-mode-line-buffer-identification
 360          '("Riece: "
 361            riece-away-indicator
 362            riece-operator-indicator
 363            riece-freeze-indicator
 364            " "
 365            riece-channel-indicator))))
 366
 367 (defun riece-channel-list-mode ()
 368   "Major mode for displaying channel list.
 369 All normal editing commands are turned off."
 370   (kill-all-local-variables)
 371   (buffer-disable-undo)
 372   (make-local-variable 'riece-redisplay-buffer)
 373   (setq major-mode 'riece-channel-list-mode
 374         mode-name "Channels"
 375         mode-line-buffer-identification
 376         (riece-mode-line-buffer-identification '("Riece: "))
 377         truncate-lines t
 378         buffer-read-only t)
 379   (use-local-map riece-channel-list-mode-map)
 380   (run-hooks 'riece-channel-list-mode-hook))
 381
 382 (defun riece-user-list-mode ()
 383   "Major mode for displaying members in the IRC current channel buffer.
 384 All normal editing commands are turned off.
 385 Instead, these commands are available:
 386 \\{riece-user-list-mode-map}"
 387   (kill-all-local-variables)
 388   (buffer-disable-undo)
 389   (make-local-variable 'riece-redisplay-buffer)
 390   (setq major-mode 'riece-user-list-mode
 391         mode-name "User list"
 392         mode-line-buffer-identification
 393         (riece-mode-line-buffer-identification
 394          '("Riece: " riece-channel-indicator " "))
 395         truncate-lines t
 396         buffer-read-only t)
 397   (if (boundp 'transient-mark-mode)
 398       (set (make-local-variable 'transient-mark-mode) t))
 399   (use-local-map riece-user-list-mode-map)
 400   (run-hooks 'riece-user-list-mode-hook))
 401
 402 (defun riece-create-buffers ()
 403   (let ((alist riece-buffer-mode-alist))
 404     (while alist
 405       (save-excursion
 406         (set-buffer (riece-get-buffer-create
 407                      (symbol-value (car (car alist)))))
 408         (unless (or (null (cdr (car alist)))
 409                     (eq major-mode (cdr (car alist))))
 410           (funcall (cdr (car alist))))
 411         (setq alist (cdr alist))))))
 412
 413 (defun riece-load-and-build-addon-dependencies (addons)
 414   (let ((load-path (cons riece-addon-directory load-path))
 415         dependencies)
 416     (while addons
 417       (require (car addons))            ;error will be reported here
 418       (let* ((requires
 419               (funcall (or (intern-soft
 420                             (concat (symbol-name (car addons)) "-requires"))
 421                            #'ignore)))
 422              (pointer requires)
 423              entry)
 424         ;; Increment succs' pred count.
 425         (if (setq entry (assq (car addons) dependencies))
 426             (setcar (cdr entry) (+ (length requires) (nth 1 entry)))
 427           (setq dependencies (cons (list (car addons) (length requires))
 428                                    dependencies)))
 429         ;; Merge pred's succs.
 430         (while pointer
 431           (if (setq entry (assq (car pointer) dependencies))
 432               (setcdr (cdr entry)
 433                       (cons (car addons) (nthcdr 2 entry)))
 434             (setq dependencies (cons (list (car pointer) 0 (car addons))
 435                                      dependencies)))
 436           (setq pointer (cdr pointer))))
 437       (setq addons (cdr addons)))
 438     dependencies))
 439
 440 (defun riece-insinuate-addons (addons)
 441   (let ((pointer addons)
 442         dependencies queue)
 443     ;; Uniquify, first.
 444     (while pointer
 445       (if (memq (car pointer) (cdr pointer))
 446           (setcar pointer nil))
 447       (setq pointer (cdr pointer)))
 448     (setq dependencies (riece-load-and-build-addon-dependencies
 449                         (delq nil addons))
 450           pointer dependencies)
 451     ;; Sort them.
 452     (while pointer
 453       (if (zerop (nth 1 (car pointer)))
 454           (setq dependencies (delq (car pointer) dependencies)
 455                 queue (cons (car pointer) queue)))
 456       (setq pointer (cdr pointer)))
 457     (setq addons nil)
 458     (while queue
 459       (setq addons (cons (car (car queue)) addons)
 460             pointer (nthcdr 2 (car queue)))
 461       (while pointer
 462         (let* ((entry (assq (car pointer) dependencies))
 463                (count (1- (nth 1 entry))))
 464           (if (zerop count)
 465               (progn
 466                 (setq dependencies (delq entry dependencies)
 467                       queue (nconc queue (list entry))))
 468             (setcar (cdr entry) count)))
 469         (setq pointer (cdr pointer)))
 470       (setq queue (cdr queue)))
 471     (if dependencies
 472         (error "Circular add-on dependency found"))
 473     (while addons
 474       (require (car addons))            ;implicit dependency
 475       (funcall (intern (concat (symbol-name (car addons)) "-insinuate")))
 476       (setq addons (cdr addons)))))
 477
 478 (provide 'riece)
 479
 480 ;;; riece.el ends here