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