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., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Code:
  26
  27 (require 'riece-display)
  28 (require 'riece-server)
  29 (require 'riece-compat)
  30 (require 'riece-commands)
  31 (require 'riece-addon)
  32 (require 'riece-signal)
  33
  34 (defvar riece-channel-list-mode-map (make-sparse-keymap))
  35 (defvar riece-user-list-mode-map (make-sparse-keymap))
  36
  37 (defvar riece-dialogue-mode-map
  38   (let ((keymap (make-keymap)))
  39     (suppress-keymap keymap 'nodigit)
  40     keymap))
  41
  42 (defvar riece-command-mode-map (make-keymap))
  43 (defvar riece-command-map (make-sparse-keymap))
  44
  45 (defvar riece-command-mode-syntax-table nil)
  46
  47 (put 'riece-command-mode 'mode-class 'special)
  48 (put 'riece-dialogue-mode 'mode-class 'special)
  49 (put 'riece-others-mode 'derived-mode-parent 'riece-dialogue-mode)
  50 (put 'riece-channel-list-mode 'mode-class 'special)
  51 (put 'riece-user-list-mode 'mode-class 'special)
  52 (put 'riece-channel-mode 'derived-mode-parent 'riece-dialogue-mode)
  53
  54 (defvar riece-buffer-alist
  55   '((riece-command-buffer "*Command*" riece-command-mode)
  56     (riece-dialogue-buffer "*Dialogue*" riece-dialogue-mode)
  57     (riece-others-buffer "*Others*" riece-others-mode)
  58     (riece-channel-list-buffer "*Channels*" riece-channel-list-mode)
  59     (riece-user-list-buffer " *Users*" riece-user-list-mode)
  60     (riece-temp-buffer " *Temp*")
  61     (riece-debug-buffer "*Debug*")))
  62
  63 (defvar riece-select-keys
  64   `("#" riece-command-switch-to-channel-by-number
  65     "1" riece-command-switch-to-channel-by-number-1
  66     "2" riece-command-switch-to-channel-by-number-2
  67     "3" riece-command-switch-to-channel-by-number-3
  68     "4" riece-command-switch-to-channel-by-number-4
  69     "5" riece-command-switch-to-channel-by-number-5
  70     "6" riece-command-switch-to-channel-by-number-6
  71     "7" riece-command-switch-to-channel-by-number-7
  72     "8" riece-command-switch-to-channel-by-number-8
  73     "9" riece-command-switch-to-channel-by-number-9
  74     "0" riece-command-switch-to-channel-by-number-10
  75     ,(concat riece-command-prefix "1")
  76     riece-command-switch-to-channel-by-number-11
  77     ,(concat riece-command-prefix "2")
  78     riece-command-switch-to-channel-by-number-12
  79     ,(concat riece-command-prefix "3")
  80     riece-command-switch-to-channel-by-number-13
  81     ,(concat riece-command-prefix "4")
  82     riece-command-switch-to-channel-by-number-14
  83     ,(concat riece-command-prefix "5")
  84     riece-command-switch-to-channel-by-number-15
  85     ,(concat riece-command-prefix "6")
  86     riece-command-switch-to-channel-by-number-16
  87     ,(concat riece-command-prefix "7")
  88     riece-command-switch-to-channel-by-number-17
  89     ,(concat riece-command-prefix "8")
  90     riece-command-switch-to-channel-by-number-18
  91     ,(concat riece-command-prefix "9")
  92     riece-command-switch-to-channel-by-number-19
  93     ,(concat riece-command-prefix "0")
  94     riece-command-switch-to-channel-by-number-20))
  95
  96 ;;; Keymap macros. -- borrowed from `gnus-util.el'.
  97 (defmacro riece-local-set-keys (&rest plist)
  98   "Set the keys in PLIST in the current keymap."
  99   `(riece-define-keys-1 (current-local-map) ',plist))
 100
 101 (defmacro riece-define-keys (keymap &rest plist)
 102   "Assign KEYMAP keys from PLIST."
 103   `(riece-define-keys-1 ',keymap ',plist))
 104
 105 (defmacro riece-define-keys-safe (keymap &rest plist)
 106   "Assign KEYMAP keys from PLIST without overwriting previous definitions."
 107   `(riece-define-keys-1 ',keymap ',plist t))
 108
 109 (put 'riece-define-keys 'lisp-indent-function 1)
 110 (put 'riece-define-keys-safe 'lisp-indent-function 1)
 111 (put 'riece-local-set-keys 'lisp-indent-function 1)
 112
 113 (defun riece-define-keys-1 (keymap plist &optional safe)
 114   "Assign KEYMAP keys from PLIST.
 115 If optional argument SAFE is nil, overwrite previous definitions."
 116   (unless keymap
 117     (error "Can't set keys in a null keymap"))
 118   (cond
 119    ((symbolp keymap)
 120     (setq keymap (symbol-value keymap)))
 121    ((keymapp keymap))
 122    ((listp keymap)
 123     (set (car keymap) nil)
 124     (define-prefix-command (car keymap))
 125     (define-key (symbol-value (nth 2 keymap))
 126       (if (symbolp (nth 1 keymap))
 127           (symbol-value (nth 1 keymap))
 128         (nth 1 keymap))
 129       (car keymap))
 130     (setq keymap (symbol-value (car keymap)))))
 131   (let (key)
 132     (while plist
 133       (if (symbolp (setq key (car plist)))
 134           (setq key (symbol-value key)))
 135       (setq plist (cdr plist))
 136       (if (or (not safe)
 137               (eq (lookup-key keymap key) 'undefined))
 138           (define-key keymap key (car plist))
 139         (car plist))
 140       (setq plist (cdr plist)))))
 141
 142 (when t
 143   (riece-define-keys riece-dialogue-mode-map
 144     "\177" scroll-down
 145     [delete] scroll-down
 146     [backspace] scroll-down
 147     [return] scroll-up
 148     " " scroll-up
 149     [home] beginning-of-buffer
 150     "$" end-of-buffer
 151     [end] end-of-buffer
 152     "/" riece-command-raw
 153     ">" end-of-buffer
 154     "<" beginning-of-buffer
 155     "^" riece-command-list-addons
 156     "\C-ta" riece-command-toggle-away
 157     "c" riece-command-select-command-buffer
 158     "f" riece-command-finger
 159     "\C-tf" riece-command-toggle-freeze
 160     "\C-to" riece-command-toggle-own-freeze
 161     "\C-tO" riece-command-toggle-others-buffer-mode
 162     "\C-tu" riece-command-toggle-user-list-buffer-mode
 163     "\C-tc" riece-command-toggle-channel-buffer-mode
 164     "\C-tC" riece-command-toggle-channel-list-buffer-mode
 165     "\C-tl" riece-command-change-layout
 166     "i" riece-command-invite
 167     "j" riece-command-join
 168     "\C-k" riece-command-kick
 169     "l" riece-command-list
 170     "M" riece-command-change-mode
 171     "n" riece-command-change-nickname
 172     "N" riece-command-names
 173     "o" other-window
 174     "O" riece-command-open-server
 175     "C" riece-command-close-server
 176     "M" riece-command-universal-server-name-argument
 177     "p" riece-command-enter-message-to-user
 178     "q" riece-command-quit
 179     "r" riece-command-configure-windows
 180     "s" riece-command-save-variables
 181     "x" riece-command-copy-region
 182     "t" riece-command-topic
 183     "w" riece-command-who
 184     "z" riece-command-suspend-resume)
 185
 186   (riece-define-keys riece-command-mode-map
 187     "\r" riece-command-enter-message
 188     [(control return)] riece-command-enter-message-as-notice
 189     [tab] riece-command-complete-user)
 190
 191   (riece-define-keys (riece-command-map riece-command-prefix
 192                                         riece-command-mode-map)
 193     "\177" riece-command-scroll-down
 194     [delete] riece-command-scroll-down
 195     [backspace] riece-command-scroll-down
 196     " " riece-command-scroll-up
 197     [home] riece-command-beginning-of-buffer
 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-saved-variables-file'."
 250   (message (riece-mcat "Saving %s...") riece-saved-variables-file)
 251   (with-temp-file riece-saved-variables-file
 252     (insert ";;; This file is generated automatically by " riece-version ".\n"
 253             ";;; Do not edit this file!\n\n")
 254     (let ((print-quoted t)
 255           (print-readably t)
 256           print-escape-multibyte
 257           print-level
 258           print-length
 259           (variables riece-saved-forms))
 260       (while variables
 261         (prin1 `(setq ,(car variables)
 262                       ',(symbol-value (car variables)))
 263                (current-buffer))
 264         (insert "\n")
 265         (setq variables (cdr variables)))))
 266   (message (riece-mcat "Saving %s...done") riece-saved-variables-file)
 267   (setq riece-save-variables-are-dirty nil))
 268
 269 ;;;###autoload
 270 (defun riece (&optional confirm)
 271   "Connect to the IRC server and start chatting.
 272 If optional argument CONFIRM is non-nil, ask which IRC server to connect."
 273   (interactive "P")
 274   (riece-read-variables-files (if noninteractive
 275                                   (car command-line-args-left)))
 276   (run-hooks 'riece-after-load-startup-hook)
 277   (if (riece-server-opened)
 278       (riece-command-configure-windows)
 279     (modify-frame-parameters (selected-frame)
 280                              (list (cons 'riece-window-configuration
 281                                          (current-window-configuration))))
 282     (setq riece-addon-dependencies (riece-resolve-addons
 283                                     (copy-sequence riece-addons)))
 284     (let ((pointer riece-addon-dependencies))
 285       (while pointer
 286         (riece-insinuate-addon (car (car pointer)) riece-debug)
 287         (setq pointer (cdr pointer))))
 288     (if (or confirm (null riece-server))
 289         (setq riece-server (completing-read (riece-mcat "Server: ")
 290                                             riece-server-alist)))
 291     (if (stringp riece-server)
 292         (setq riece-server (riece-server-name-to-server riece-server)))
 293     (riece-create-buffers)
 294     (switch-to-buffer riece-command-buffer)
 295     (riece-display-connect-signals)
 296     (riece-redisplay-buffers)
 297     (riece-open-server riece-server "")
 298     ;; If no server process is available, exit.
 299     (if (null riece-server-process-alist)
 300         (riece-exit)
 301       (let ((server-list riece-startup-server-list))
 302         (while server-list
 303           (riece-command-open-server (car server-list))
 304           (setq server-list (cdr server-list))))
 305       (let ((channel-list riece-startup-channel-list)
 306             server)
 307         (while channel-list
 308           (setq server (riece-identity-server
 309                         (riece-parse-identity (car channel-list))))
 310           (unless (riece-server-opened server)
 311             (riece-command-open-server server))
 312           (setq channel-list (cdr channel-list))))
 313       (let ((pointer riece-addon-dependencies))
 314         (while pointer
 315           (unless (get (car (car pointer)) 'riece-addon-default-disabled)
 316             (riece-enable-addon (car (car pointer)) riece-debug))
 317           (setq pointer (cdr pointer))))
 318       (run-hooks 'riece-startup-hook)
 319       (message "%s" (substitute-command-keys
 320                      (riece-mcat "Type \\[describe-mode] for help"))))))
 321
 322 (defun riece-exit ()
 323   (if riece-save-variables-are-dirty
 324       (riece-save-variables-files))
 325   (while riece-buffer-list
 326     (if (and (get-buffer (car riece-buffer-list))
 327              (buffer-live-p (car riece-buffer-list)))
 328         (funcall riece-buffer-dispose-function (car riece-buffer-list)))
 329     (setq riece-buffer-list (cdr riece-buffer-list)))
 330   (riece-clear-signal-slots)
 331   (setq riece-server nil
 332         riece-current-channels nil
 333         riece-current-channel nil
 334         riece-channel-buffer nil
 335         riece-channel-buffer-alist nil
 336         riece-user-indicator nil
 337         riece-long-channel-indicator (riece-mcat "None")
 338         riece-channel-list-indicator (riece-mcat "No channel")
 339         riece-away-indicator "-"
 340         riece-operator-indicator "-"
 341         riece-channel-status-indicator "-"
 342         riece-freeze-indicator "-")
 343   (modify-frame-parameters (selected-frame)
 344                            (list (list 'riece-window-configuration)))
 345   (delete-other-windows)
 346   (run-hooks 'riece-exit-hook))
 347
 348 (defun riece-command-mode ()
 349   "Major mode for Riece.  Normal edit function are available.
 350 Typing Return or Linefeed enters the current line in the dialogue.
 351 The following special commands are available:
 352 For a list of the generic commands type \\[riece-command-generic] ? RET.
 353 \\{riece-command-mode-map}"
 354   (interactive)
 355   (kill-all-local-variables)
 356
 357   ;; Make `truncate-partial-width-windows' buffer local and set it to
 358   ;; nil.  This causes `truncate-lines' to directly control line
 359   ;; truncation.
 360   (make-local-variable 'truncate-partial-width-windows)
 361   (setq truncate-partial-width-windows nil)
 362
 363   (make-local-variable 'riece-mode-line-buffer-identification)
 364   (setq riece-away-indicator "-"
 365         riece-operator-indicator "-"
 366         riece-channel-status-indicator "-"
 367         major-mode 'riece-command-mode
 368         mode-name "Command"
 369         riece-mode-line-buffer-identification
 370         '("Riece: "
 371           riece-away-indicator
 372           riece-operator-indicator
 373           riece-channel-status-indicator
 374           " "
 375           riece-user-indicator
 376           " "
 377           riece-channel-indicator)
 378         mode-line-buffer-identification
 379         (riece-mode-line-buffer-identification
 380          riece-mode-line-buffer-identification)
 381         truncate-lines nil)
 382   (riece-simplify-mode-line-format)
 383   (use-local-map riece-command-mode-map)
 384
 385   (unless riece-command-mode-syntax-table
 386     (setq riece-command-mode-syntax-table
 387           (copy-syntax-table (syntax-table)))
 388     (set-syntax-table riece-command-mode-syntax-table)
 389     (let* ((chars "^[]{}'`")
 390            (length (length chars))
 391            (index 0))
 392       (while (< index length)
 393         (modify-syntax-entry (aref chars index) "w")
 394         (setq index (1+ index)))))
 395
 396   (run-hooks 'riece-command-mode-hook))
 397
 398 (defun riece-dialogue-mode ()
 399   "Major mode for displaying the IRC dialogue.
 400 All normal editing commands are turned off.
 401 Instead, these commands are available:
 402 \\{riece-dialogue-mode-map}"
 403   (kill-all-local-variables)
 404   (make-local-variable 'riece-freeze)
 405   (make-local-variable 'riece-freeze-indicator)
 406
 407   ;; Make `truncate-partial-width-windows' buffer local and set it to
 408   ;; nil.  This causes `truncate-lines' to directly control line truncation.
 409   (make-local-variable 'truncate-partial-width-windows)
 410   (setq truncate-partial-width-windows nil)
 411
 412   (make-local-variable 'riece-mode-line-buffer-identification)
 413   (setq riece-freeze riece-default-freeze
 414         riece-away-indicator "-"
 415         riece-operator-indicator "-"
 416         riece-channel-status-indicator "-"
 417         major-mode 'riece-dialogue-mode
 418         mode-name "Dialogue"
 419         riece-mode-line-buffer-identification
 420         '("Riece: "
 421           riece-away-indicator
 422           riece-operator-indicator
 423           riece-freeze-indicator
 424           riece-channel-status-indicator
 425           " "
 426           riece-channel-list-indicator " ")
 427         mode-line-buffer-identification
 428         (riece-mode-line-buffer-identification
 429          riece-mode-line-buffer-identification)
 430         truncate-lines nil
 431         buffer-read-only t)
 432   (riece-simplify-mode-line-format)
 433   (use-local-map riece-dialogue-mode-map)
 434   (buffer-disable-undo)
 435   (run-hooks 'riece-dialogue-mode-hook))
 436
 437 (define-derived-mode riece-others-mode riece-dialogue-mode
 438   "Others"
 439   "Major mode for displaying the IRC others message except current channel.
 440 All normal editing commands are turned off.
 441 Instead, these commands are available:
 442 \\{riece-others-mode-map}")
 443
 444 (define-derived-mode riece-channel-mode riece-dialogue-mode
 445   "Channel"
 446   "Major mode for displaying the IRC current channel buffer.
 447 All normal editing commands are turned off.
 448 Instead, these commands are available:
 449 \\{riece-channel-mode-map}"
 450   (make-local-variable 'riece-channel-buffer-window-point)
 451   (make-local-variable 'riece-mode-line-buffer-identification)
 452   (setq riece-mode-line-buffer-identification
 453         '("Riece: "
 454           riece-away-indicator
 455           riece-operator-indicator
 456           riece-freeze-indicator
 457           riece-channel-status-indicator
 458           " "
 459           riece-long-channel-indicator)
 460         mode-line-buffer-identification
 461         (riece-mode-line-buffer-identification
 462          riece-mode-line-buffer-identification)))
 463
 464 (defun riece-channel-list-mode ()
 465   "Major mode for displaying channel list.
 466 All normal editing commands are turned off."
 467   (kill-all-local-variables)
 468   (buffer-disable-undo)
 469
 470   ;; Make `truncate-partial-width-windows' buffer local and set it to
 471   ;; nil.  This causes `truncate-lines' to directly control line truncation.
 472   (make-local-variable 'truncate-partial-width-windows)
 473   (setq truncate-partial-width-windows nil)
 474
 475   (make-local-variable 'riece-mode-line-buffer-identification)
 476   (setq major-mode 'riece-channel-list-mode
 477         mode-name "Channels"
 478         riece-mode-line-buffer-identification '("Riece: ")
 479         mode-line-buffer-identification
 480         (riece-mode-line-buffer-identification
 481          riece-mode-line-buffer-identification)
 482         truncate-lines t
 483         buffer-read-only t)
 484   (riece-make-local-hook 'riece-update-buffer-functions)
 485   (add-hook 'riece-update-buffer-functions
 486             'riece-update-channel-list-buffer nil t)
 487   (use-local-map riece-channel-list-mode-map)
 488   (run-hooks 'riece-channel-list-mode-hook))
 489
 490 (defun riece-user-list-mode ()
 491   "Major mode for displaying members in the IRC current channel buffer.
 492 All normal editing commands are turned off.
 493 Instead, these commands are available:
 494 \\{riece-user-list-mode-map}"
 495   (kill-all-local-variables)
 496   (buffer-disable-undo)
 497
 498   ;; Make `truncate-partial-width-windows' buffer local and set it to
 499   ;; nil.  This causes `truncate-lines' to directly control line truncation.
 500   (make-local-variable 'truncate-partial-width-windows)
 501   (setq truncate-partial-width-windows nil)
 502
 503   (make-local-variable 'riece-mode-line-buffer-identification)
 504   (setq major-mode 'riece-user-list-mode
 505         mode-name "Users"
 506         riece-mode-line-buffer-identification
 507         '("Riece: " riece-long-channel-indicator " ")
 508         mode-line-buffer-identification
 509         (riece-mode-line-buffer-identification
 510          riece-mode-line-buffer-identification)
 511         truncate-lines t
 512         buffer-read-only t)
 513   (if (boundp 'transient-mark-mode)
 514       (set (make-local-variable 'transient-mark-mode) t))
 515   (riece-make-local-hook 'riece-update-buffer-functions)
 516   (add-hook 'riece-update-buffer-functions
 517             'riece-update-user-list-buffer nil t)
 518   (use-local-map riece-user-list-mode-map)
 519   (run-hooks 'riece-user-list-mode-hook))
 520
 521 (defun riece-create-buffers ()
 522   (let ((alist riece-buffer-alist))
 523     (while alist
 524       (save-excursion
 525         (set-buffer (apply #'riece-get-buffer-create
 526                            (cdr (car alist))))
 527         (set (car (car alist)) (current-buffer))
 528         (unless (or (null (nth 2 (car alist)))
 529                     (eq major-mode (nth 2 (car alist))))
 530           (funcall (nth 2 (car alist))))
 531         (setq alist (cdr alist))))))
 532
 533 (defun riece-submit-bug-report ()
 534   "Submit via mail a bug report on Riece."
 535   (interactive)
 536   (browse-url "https://savannah.nongnu.org/bugs/?group=riece"))
 537
 538 (provide 'riece)
 539
 540 ;;; riece.el ends here