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