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