cgit.sxemacs.org Git - riece/blob - lisp/riece.el

   1 ;;; riece.el --- IRC client for Emacsen -*- lexical-binding: t -*-
   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 (defvar print-readably)
 249 (defun riece-save-variables-files ()
 250   "Save current settings to `riece-saved-variables-file'."
 251   (message (riece-mcat "Saving %s...") riece-saved-variables-file)
 252   (with-temp-file riece-saved-variables-file
 253     (insert ";;; This file is generated automatically by " riece-version ".\n"
 254             ";;; Do not edit this file!\n\n")
 255     (let ((print-quoted t)
 256           (print-readably t)
 257           print-escape-multibyte
 258           print-level
 259           print-length
 260           (variables riece-saved-forms))
 261       (while variables
 262         (prin1 `(setq ,(car variables)
 263                       ',(symbol-value (car variables)))
 264                (current-buffer))
 265         (insert "\n")
 266         (setq variables (cdr variables)))))
 267   (message (riece-mcat "Saving %s...done") riece-saved-variables-file)
 268   (setq riece-save-variables-are-dirty nil))
 269
 270 ;;;###autoload
 271 (defun riece (&optional confirm)
 272   "Connect to the IRC server and start chatting.
 273 If optional argument CONFIRM is non-nil, ask which IRC server to connect."
 274   (interactive "P")
 275   (riece-read-variables-files (if noninteractive
 276                                   (car command-line-args-left)))
 277   (run-hooks 'riece-after-load-startup-hook)
 278   (if (riece-server-opened)
 279       (riece-command-configure-windows)
 280     (modify-frame-parameters (selected-frame)
 281                              (list (cons 'riece-window-configuration
 282                                          (current-window-configuration))))
 283     (setq riece-addon-dependencies (riece-resolve-addons
 284                                     (copy-sequence riece-addons)))
 285     (let ((pointer riece-addon-dependencies))
 286       (while pointer
 287         (riece-insinuate-addon (car (car pointer)) riece-debug)
 288         (setq pointer (cdr pointer))))
 289     (if (or confirm (null riece-server))
 290         (setq riece-server (completing-read (riece-mcat "Server: ")
 291                                             riece-server-alist)))
 292     (if (stringp riece-server)
 293         (setq riece-server (riece-server-name-to-server riece-server)))
 294     (riece-create-buffers)
 295     (switch-to-buffer riece-command-buffer)
 296     (riece-display-connect-signals)
 297     (riece-redisplay-buffers)
 298     (riece-open-server riece-server "")
 299     ;; If no server process is available, exit.
 300     (if (null riece-server-process-alist)
 301         (riece-exit)
 302       (let ((server-list riece-startup-server-list))
 303         (while server-list
 304           (riece-command-open-server (car server-list))
 305           (setq server-list (cdr server-list))))
 306       (let ((channel-list riece-startup-channel-list)
 307             server)
 308         (while channel-list
 309           (setq server (riece-identity-server
 310                         (riece-parse-identity (car channel-list))))
 311           (unless (riece-server-opened server)
 312             (riece-command-open-server server))
 313           (setq channel-list (cdr channel-list))))
 314       (let ((pointer riece-addon-dependencies))
 315         (while pointer
 316           (unless (get (car (car pointer)) 'riece-addon-default-disabled)
 317             (riece-enable-addon (car (car pointer)) riece-debug))
 318           (setq pointer (cdr pointer))))
 319       (run-hooks 'riece-startup-hook)
 320       (message "%s" (substitute-command-keys
 321                      (riece-mcat "Type \\[describe-mode] for help"))))))
 322
 323 (defun riece-exit ()
 324   (if riece-save-variables-are-dirty
 325       (riece-save-variables-files))
 326   (while riece-buffer-list
 327     (if (and (get-buffer (car riece-buffer-list))
 328              (buffer-live-p (car riece-buffer-list)))
 329         (funcall riece-buffer-dispose-function (car riece-buffer-list)))
 330     (setq riece-buffer-list (cdr riece-buffer-list)))
 331   (riece-clear-signal-slots)
 332   (setq riece-server nil
 333         riece-current-channels nil
 334         riece-current-channel nil
 335         riece-channel-buffer nil
 336         riece-channel-buffer-alist nil
 337         riece-user-indicator nil
 338         riece-long-channel-indicator (riece-mcat "None")
 339         riece-channel-list-indicator (riece-mcat "No channel")
 340         riece-away-indicator "-"
 341         riece-operator-indicator "-"
 342         riece-channel-status-indicator "-"
 343         riece-freeze-indicator "-")
 344   (modify-frame-parameters (selected-frame)
 345                            (list (list 'riece-window-configuration)))
 346   (delete-other-windows)
 347   (run-hooks 'riece-exit-hook))
 348
 349 (defun riece-command-mode ()
 350   "Major mode for Riece.  Normal edit function are available.
 351 Typing Return or Linefeed enters the current line in the dialogue.
 352 The following special commands are available:
 353 For a list of the generic commands type \\[riece-command-generic] ? RET.
 354 \\{riece-command-mode-map}"
 355   (interactive)
 356   (kill-all-local-variables)
 357
 358   ;; Make `truncate-partial-width-windows' buffer local and set it to
 359   ;; nil.  This causes `truncate-lines' to directly control line
 360   ;; truncation.
 361   (make-local-variable 'truncate-partial-width-windows)
 362   (setq truncate-partial-width-windows nil)
 363
 364   (make-local-variable 'riece-mode-line-buffer-identification)
 365   (setq riece-away-indicator "-"
 366         riece-operator-indicator "-"
 367         riece-channel-status-indicator "-"
 368         major-mode 'riece-command-mode
 369         mode-name "Command"
 370         riece-mode-line-buffer-identification
 371         '("Riece: "
 372           riece-away-indicator
 373           riece-operator-indicator
 374           riece-channel-status-indicator
 375           " "
 376           riece-user-indicator
 377           " "
 378           riece-channel-indicator)
 379         mode-line-buffer-identification
 380         (riece-mode-line-buffer-identification
 381          riece-mode-line-buffer-identification)
 382         truncate-lines nil)
 383   (riece-simplify-mode-line-format)
 384   (use-local-map riece-command-mode-map)
 385
 386   (unless riece-command-mode-syntax-table
 387     (setq riece-command-mode-syntax-table
 388           (copy-syntax-table (syntax-table)))
 389     (set-syntax-table riece-command-mode-syntax-table)
 390     (let* ((chars "^[]{}'`")
 391            (length (length chars))
 392            (index 0))
 393       (while (< index length)
 394         (modify-syntax-entry (aref chars index) "w")
 395         (setq index (1+ index)))))
 396
 397   (run-hooks 'riece-command-mode-hook))
 398
 399 (defun riece-dialogue-mode ()
 400   "Major mode for displaying the IRC dialogue.
 401 All normal editing commands are turned off.
 402 Instead, these commands are available:
 403 \\{riece-dialogue-mode-map}"
 404   (kill-all-local-variables)
 405   (make-local-variable 'riece-freeze)
 406   (make-local-variable 'riece-freeze-indicator)
 407
 408   ;; Make `truncate-partial-width-windows' buffer local and set it to
 409   ;; nil.  This causes `truncate-lines' to directly control line truncation.
 410   (make-local-variable 'truncate-partial-width-windows)
 411   (setq truncate-partial-width-windows nil)
 412
 413   (make-local-variable 'riece-mode-line-buffer-identification)
 414   (setq riece-freeze riece-default-freeze
 415         riece-away-indicator "-"
 416         riece-operator-indicator "-"
 417         riece-channel-status-indicator "-"
 418         major-mode 'riece-dialogue-mode
 419         mode-name "Dialogue"
 420         riece-mode-line-buffer-identification
 421         '("Riece: "
 422           riece-away-indicator
 423           riece-operator-indicator
 424           riece-freeze-indicator
 425           riece-channel-status-indicator
 426           " "
 427           riece-channel-list-indicator " ")
 428         mode-line-buffer-identification
 429         (riece-mode-line-buffer-identification
 430          riece-mode-line-buffer-identification)
 431         truncate-lines nil
 432         buffer-read-only t)
 433   (riece-simplify-mode-line-format)
 434   (use-local-map riece-dialogue-mode-map)
 435   (buffer-disable-undo)
 436   (run-hooks 'riece-dialogue-mode-hook))
 437
 438 (define-derived-mode riece-others-mode riece-dialogue-mode
 439   "Others"
 440   "Major mode for displaying the IRC others message except current channel.
 441 All normal editing commands are turned off.
 442 Instead, these commands are available:
 443 \\{riece-others-mode-map}")
 444
 445 (define-derived-mode riece-channel-mode riece-dialogue-mode
 446   "Channel"
 447   "Major mode for displaying the IRC current channel buffer.
 448 All normal editing commands are turned off.
 449 Instead, these commands are available:
 450 \\{riece-channel-mode-map}"
 451   (make-local-variable 'riece-channel-buffer-window-point)
 452   (make-local-variable 'riece-mode-line-buffer-identification)
 453   (setq riece-mode-line-buffer-identification
 454         '("Riece: "
 455           riece-away-indicator
 456           riece-operator-indicator
 457           riece-freeze-indicator
 458           riece-channel-status-indicator
 459           " "
 460           riece-long-channel-indicator)
 461         mode-line-buffer-identification
 462         (riece-mode-line-buffer-identification
 463          riece-mode-line-buffer-identification)))
 464
 465 (defun riece-channel-list-mode ()
 466   "Major mode for displaying channel list.
 467 All normal editing commands are turned off."
 468   (kill-all-local-variables)
 469   (buffer-disable-undo)
 470
 471   ;; Make `truncate-partial-width-windows' buffer local and set it to
 472   ;; nil.  This causes `truncate-lines' to directly control line truncation.
 473   (make-local-variable 'truncate-partial-width-windows)
 474   (setq truncate-partial-width-windows nil)
 475
 476   (make-local-variable 'riece-mode-line-buffer-identification)
 477   (setq major-mode 'riece-channel-list-mode
 478         mode-name "Channels"
 479         riece-mode-line-buffer-identification '("Riece: ")
 480         mode-line-buffer-identification
 481         (riece-mode-line-buffer-identification
 482          riece-mode-line-buffer-identification)
 483         truncate-lines t
 484         buffer-read-only t)
 485   (riece-make-local-hook 'riece-update-buffer-functions)
 486   (add-hook 'riece-update-buffer-functions
 487             'riece-update-channel-list-buffer nil t)
 488   (use-local-map riece-channel-list-mode-map)
 489   (run-hooks 'riece-channel-list-mode-hook))
 490
 491 (defun riece-user-list-mode ()
 492   "Major mode for displaying members in the IRC current channel buffer.
 493 All normal editing commands are turned off.
 494 Instead, these commands are available:
 495 \\{riece-user-list-mode-map}"
 496   (kill-all-local-variables)
 497   (buffer-disable-undo)
 498
 499   ;; Make `truncate-partial-width-windows' buffer local and set it to
 500   ;; nil.  This causes `truncate-lines' to directly control line truncation.
 501   (make-local-variable 'truncate-partial-width-windows)
 502   (setq truncate-partial-width-windows nil)
 503
 504   (make-local-variable 'riece-mode-line-buffer-identification)
 505   (setq major-mode 'riece-user-list-mode
 506         mode-name "Users"
 507         riece-mode-line-buffer-identification
 508         '("Riece: " riece-long-channel-indicator " ")
 509         mode-line-buffer-identification
 510         (riece-mode-line-buffer-identification
 511          riece-mode-line-buffer-identification)
 512         truncate-lines t
 513         buffer-read-only t)
 514   (if (boundp 'transient-mark-mode)
 515       (set (make-local-variable 'transient-mark-mode) t))
 516   (riece-make-local-hook 'riece-update-buffer-functions)
 517   (add-hook 'riece-update-buffer-functions
 518             'riece-update-user-list-buffer nil t)
 519   (use-local-map riece-user-list-mode-map)
 520   (run-hooks 'riece-user-list-mode-hook))
 521
 522 (defun riece-create-buffers ()
 523   (let ((alist riece-buffer-alist))
 524     (while alist
 525       (with-current-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