* riece.el (riece-create-buffers): Suppress byte-compile
[riece] / lisp / riece.el
index 802ef5d..bce18ad 100644 (file)
@@ -19,8 +19,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Code:
 
@@ -31,8 +31,6 @@
 (require 'riece-addon)
 (require 'riece-signal)
 
-(autoload 'derived-mode-class "derived")
-
 (defvar riece-channel-list-mode-map (make-sparse-keymap))
 (defvar riece-user-list-mode-map (make-sparse-keymap))
 
     (riece-channel-list-buffer "*Channels*" riece-channel-list-mode)
     (riece-user-list-buffer " *Users*" riece-user-list-mode)
     (riece-temp-buffer " *Temp*")
-    (riece-debug-buffer " *Debug*")))
-
-(defvar riece-shrink-buffer-idle-timer nil
-  "Timer object to periodically shrink channel buffers.")
+    (riece-debug-buffer "*Debug*")))
 
 (defvar riece-select-keys
   `("#" riece-command-switch-to-channel-by-number
@@ -182,6 +177,7 @@ If optional argument SAFE is nil, overwrite previous definitions."
     "p" riece-command-enter-message-to-user
     "q" riece-command-quit
     "r" riece-command-configure-windows
+    "s" riece-command-save-variables
     "x" riece-command-copy-region
     "t" riece-command-topic
     "w" riece-command-who
@@ -250,8 +246,11 @@ If optional argument SAFE is nil, overwrite previous definitions."
 (defvar print-quoted)
 (defvar print-escape-multibyte)
 (defun riece-save-variables-files ()
-  "Save current settings to `riece-variables-file'."
+  "Save current settings to `riece-saved-variables-file'."
+  (message (riece-mcat "Saving %s...") riece-saved-variables-file)
   (with-temp-file riece-saved-variables-file
+    (insert ";;; This file is generated automatically by " riece-version ".\n"
+           ";;; Do not edit this file!\n\n")
     (let ((print-quoted t)
          (print-readably t)
          print-escape-multibyte
@@ -264,6 +263,7 @@ If optional argument SAFE is nil, overwrite previous definitions."
               (current-buffer))
        (insert "\n")
        (setq variables (cdr variables)))))
+  (message (riece-mcat "Saving %s...done") riece-saved-variables-file)
   (setq riece-save-variables-are-dirty nil))
 
 ;;;###autoload
@@ -279,31 +279,18 @@ If optional argument CONFIRM is non-nil, ask which IRC server to connect."
     (modify-frame-parameters (selected-frame)
                             (list (cons 'riece-window-configuration
                                         (current-window-configuration))))
-    (setq riece-addons (riece-resolve-addons riece-addons))
-    (let ((pointer riece-addons))
+    (setq riece-addon-dependencies (riece-resolve-addons
+                                   (copy-sequence riece-addons)))
+    (let ((pointer riece-addon-dependencies))
       (while pointer
-       (riece-insinuate-addon (car pointer) riece-debug)
+       (riece-insinuate-addon (car (car pointer)) riece-debug)
        (setq pointer (cdr pointer))))
     (if (or confirm (null riece-server))
-       (setq riece-server (completing-read "Server: " riece-server-alist)))
+       (setq riece-server (completing-read (riece-mcat "Server: ")
+                                           riece-server-alist)))
     (if (stringp riece-server)
        (setq riece-server (riece-server-name-to-server riece-server)))
     (riece-create-buffers)
-    (if riece-max-buffer-size
-       (setq riece-shrink-buffer-idle-timer
-             (riece-run-with-idle-timer
-              riece-shrink-buffer-idle-time-delay t
-              (lambda ()
-                (let ((buffers riece-buffer-list))
-                  (while buffers
-                    (if (buffer-live-p (car buffers))
-                        (if (eq (derived-mode-class
-                                 (with-current-buffer (car buffers)
-                                   major-mode))
-                                'riece-dialogue-mode)
-                            (riece-shrink-buffer (car buffers)))
-                      (delq (car buffers) riece-buffer-list))
-                    (setq buffers (cdr buffers))))))))
     (switch-to-buffer riece-command-buffer)
     (riece-display-connect-signals)
     (riece-redisplay-buffers)
@@ -323,31 +310,14 @@ If optional argument CONFIRM is non-nil, ask which IRC server to connect."
          (unless (riece-server-opened server)
            (riece-command-open-server server))
          (setq channel-list (cdr channel-list))))
-      (let ((pointer riece-addons))
+      (let ((pointer riece-addon-dependencies))
        (while pointer
-         (unless (get (car pointer) 'riece-addon-default-disabled)
-           (riece-enable-addon (car pointer) riece-debug))
+         (unless (get (car (car pointer)) 'riece-addon-default-disabled)
+           (riece-enable-addon (car (car pointer)) riece-debug))
          (setq pointer (cdr pointer))))
       (run-hooks 'riece-startup-hook)
       (message "%s" (substitute-command-keys
-                    "Type \\[describe-mode] for help")))))
-
-(defun riece-shrink-buffer (buffer)
-  (save-excursion
-    (set-buffer buffer)
-    (goto-char (point-min))
-    (while (> (buffer-size) riece-max-buffer-size)
-      (let* ((inhibit-read-only t)
-            buffer-read-only
-            (end (progn
-                   (goto-char riece-shrink-buffer-remove-chars)
-                   (beginning-of-line 2)
-                   (point)))
-            (overlays (riece-overlays-in (point-min) end)))
-       (while overlays
-         (riece-delete-overlay (car overlays))
-         (setq overlays (cdr overlays)))
-       (delete-region (point-min) end)))))
+                    (riece-mcat "Type \\[describe-mode] for help"))))))
 
 (defun riece-exit ()
   (if riece-save-variables-are-dirty
@@ -357,8 +327,6 @@ If optional argument CONFIRM is non-nil, ask which IRC server to connect."
             (buffer-live-p (car riece-buffer-list)))
        (funcall riece-buffer-dispose-function (car riece-buffer-list)))
     (setq riece-buffer-list (cdr riece-buffer-list)))
-  (if riece-shrink-buffer-idle-timer
-      (riece-cancel-timer riece-shrink-buffer-idle-timer))
   (riece-clear-signal-slots)
   (setq riece-server nil
        riece-current-channels nil
@@ -366,8 +334,8 @@ If optional argument CONFIRM is non-nil, ask which IRC server to connect."
        riece-channel-buffer nil
        riece-channel-buffer-alist nil
        riece-user-indicator nil
-       riece-long-channel-indicator "None"
-       riece-channel-list-indicator "No channel"
+       riece-long-channel-indicator (riece-mcat "None")
+       riece-channel-list-indicator (riece-mcat "No channel")
        riece-away-indicator "-"
        riece-operator-indicator "-"
        riece-channel-status-indicator "-"
@@ -392,21 +360,24 @@ For a list of the generic commands type \\[riece-command-generic] ? RET.
   (make-local-variable 'truncate-partial-width-windows)
   (setq truncate-partial-width-windows nil)
 
+  (make-local-variable 'riece-mode-line-buffer-identification)
   (setq riece-away-indicator "-"
        riece-operator-indicator "-"
        riece-channel-status-indicator "-"
        major-mode 'riece-command-mode
        mode-name "Command"
+       riece-mode-line-buffer-identification
+       '("Riece: "
+         riece-away-indicator
+         riece-operator-indicator
+         riece-channel-status-indicator
+         " "
+         riece-user-indicator
+         " "
+         riece-channel-indicator)
        mode-line-buffer-identification
        (riece-mode-line-buffer-identification
-        '("Riece: "
-          riece-away-indicator
-          riece-operator-indicator
-          riece-channel-status-indicator
-          " "
-          riece-user-indicator
-          " "
-          riece-channel-indicator))
+        riece-mode-line-buffer-identification)
        truncate-lines nil)
   (riece-simplify-mode-line-format)
   (use-local-map riece-command-mode-map)
@@ -415,9 +386,12 @@ For a list of the generic commands type \\[riece-command-generic] ? RET.
     (setq riece-command-mode-syntax-table
          (copy-syntax-table (syntax-table)))
     (set-syntax-table riece-command-mode-syntax-table)
-    (mapcar
-     (lambda (c) (modify-syntax-entry c "w"))
-     "^[]{}'`"))
+    (let* ((chars "^[]{}'`")
+          (length (length chars))
+          (index 0))
+      (while (< index length)
+       (modify-syntax-entry (aref chars index) "w")
+       (setq index (1+ index)))))
 
   (run-hooks 'riece-command-mode-hook))
 
@@ -435,21 +409,24 @@ Instead, these commands are available:
   (make-local-variable 'truncate-partial-width-windows)
   (setq truncate-partial-width-windows nil)
 
+  (make-local-variable 'riece-mode-line-buffer-identification)
   (setq riece-freeze riece-default-freeze
        riece-away-indicator "-"
        riece-operator-indicator "-"
        riece-channel-status-indicator "-"
        major-mode 'riece-dialogue-mode
        mode-name "Dialogue"
+       riece-mode-line-buffer-identification
+       '("Riece: "
+         riece-away-indicator
+         riece-operator-indicator
+         riece-freeze-indicator
+         riece-channel-status-indicator
+         " "
+         riece-channel-list-indicator " ")
        mode-line-buffer-identification
        (riece-mode-line-buffer-identification
-        '("Riece: "
-          riece-away-indicator
-          riece-operator-indicator
-          riece-freeze-indicator
-          riece-channel-status-indicator
-          " "
-          riece-channel-list-indicator " "))
+        riece-mode-line-buffer-identification)
        truncate-lines nil
        buffer-read-only t)
   (riece-simplify-mode-line-format)
@@ -471,15 +448,18 @@ All normal editing commands are turned off.
 Instead, these commands are available:
 \\{riece-channel-mode-map}"
   (make-local-variable 'riece-channel-buffer-window-point)
-  (setq mode-line-buffer-identification
+  (make-local-variable 'riece-mode-line-buffer-identification)
+  (setq riece-mode-line-buffer-identification
+       '("Riece: "
+         riece-away-indicator
+         riece-operator-indicator
+         riece-freeze-indicator
+         riece-channel-status-indicator
+         " "
+         riece-long-channel-indicator)
+       mode-line-buffer-identification
        (riece-mode-line-buffer-identification
-        '("Riece: "
-          riece-away-indicator
-          riece-operator-indicator
-          riece-freeze-indicator
-          riece-channel-status-indicator
-          " "
-          riece-long-channel-indicator))))
+        riece-mode-line-buffer-identification)))
 
 (defun riece-channel-list-mode ()
   "Major mode for displaying channel list.
@@ -492,13 +472,16 @@ All normal editing commands are turned off."
   (make-local-variable 'truncate-partial-width-windows)
   (setq truncate-partial-width-windows nil)
 
+  (make-local-variable 'riece-mode-line-buffer-identification)
   (setq major-mode 'riece-channel-list-mode
        mode-name "Channels"
+       riece-mode-line-buffer-identification '("Riece: ")
        mode-line-buffer-identification
-       (riece-mode-line-buffer-identification '("Riece: "))
+       (riece-mode-line-buffer-identification
+        riece-mode-line-buffer-identification)
        truncate-lines t
        buffer-read-only t)
-  (make-local-hook 'riece-update-buffer-functions)
+  (riece-make-local-hook 'riece-update-buffer-functions)
   (add-hook 'riece-update-buffer-functions
            'riece-update-channel-list-buffer nil t)
   (use-local-map riece-channel-list-mode-map)
@@ -517,16 +500,19 @@ Instead, these commands are available:
   (make-local-variable 'truncate-partial-width-windows)
   (setq truncate-partial-width-windows nil)
 
+  (make-local-variable 'riece-mode-line-buffer-identification)
   (setq major-mode 'riece-user-list-mode
        mode-name "Users"
+       riece-mode-line-buffer-identification
+       '("Riece: " riece-long-channel-indicator " ")
        mode-line-buffer-identification
        (riece-mode-line-buffer-identification
-        '("Riece: " riece-long-channel-indicator " "))
+        riece-mode-line-buffer-identification)
        truncate-lines t
        buffer-read-only t)
   (if (boundp 'transient-mark-mode)
       (set (make-local-variable 'transient-mark-mode) t))
-  (make-local-hook 'riece-update-buffer-functions)
+  (riece-make-local-hook 'riece-update-buffer-functions)
   (add-hook 'riece-update-buffer-functions
            'riece-update-user-list-buffer nil t)
   (use-local-map riece-user-list-mode-map)
@@ -535,109 +521,18 @@ Instead, these commands are available:
 (defun riece-create-buffers ()
   (let ((alist riece-buffer-alist))
     (while alist
-      (save-excursion
-       (set-buffer (apply #'riece-get-buffer-create
-                          (cdr (car alist))))
+      (with-current-buffer (apply #'riece-get-buffer-create
+                                 (cdr (car alist)))
        (set (car (car alist)) (current-buffer))
        (unless (or (null (nth 2 (car alist)))
                    (eq major-mode (nth 2 (car alist))))
          (funcall (nth 2 (car alist))))
        (setq alist (cdr alist))))))
 
-(defvar reporter-prompt-for-summary-p)
-(defun riece-submit-bug-report (&optional recent-messages recent-keys)
+(defun riece-submit-bug-report ()
   "Submit via mail a bug report on Riece."
-  ;; This strange form ensures that (recent-keys) is the value before
-  ;; the bug subject string is read.
-  (interactive (list (riece-recent-messages 20) (recent-keys)))
-  (message "Querying server version...")
-  (let ((pointer riece-server-process-alist)
-       nickname)
-    (while pointer
-      (when (riece-server-process-opened (cdr (car pointer)))
-       (process-send-string (cdr (car pointer)) "VERSION\r\n")
-       (if (setq nickname
-                 (with-current-buffer (process-buffer (cdr (car pointer)))
-                   riece-real-nickname))
-           (process-send-string
-            (cdr (car pointer))
-            (format "PRIVMSG %s :\1VERSION\1\r\n" nickname))))
-      (setq pointer (cdr pointer))))
-  (sit-for 3)
-  (message "Querying server version...done")
-  (require 'reporter)
-  (let ((reporter-prompt-for-summary-p t))
-    (unless riece-debug
-      (error "Please turn on riece-debug and restart Riece."))
-    (reporter-submit-bug-report
-     "liece@unixuser.org"
-     (riece-version)
-     '(riece-debug)
-     nil
-     nil
-     "This bug report will be sent to the Riece Development Team,
-not to your local site managers!!
-
-Please write in Japanese or English, because the Riece maintainers do
-not have translators to read other languages for them.
-
-Please describe as succinctly as possible:
-\t- What happened.
-\t- What you thought should have happened.
-\t- Precisely what you were doing at the time.
-
-Also include a reliable recipe for triggering the bug, as well as
-any lisp back-traces that you may have.
-\(setq stack-trace-on-error t\), or \(setq debug-on-error t\) if you
-are familiar with the debugger, to get a lisp back-trace.")
-    (delete-other-windows)
-    (save-excursion
-      (goto-char (point-max))
-      (insert
-       "\nAdd-on state:\n"
-       "------------\n"
-       (save-window-excursion
-        (save-excursion
-          (riece-command-list-addons)
-          (search-forward "\n\n")
-          (buffer-substring (point-min) (point)))))
-      (insert "Recent messages from servers:\n"
-             "--------------------------")
-      (let ((pointer riece-server-process-alist))
-       (while pointer
-         (insert "\n- \"" (car (car pointer)) "\", \n"
-                 (format "%S" (if (equal (car (car pointer)) "")
-                                  riece-server
-                                (cdr (assoc (car (car pointer))
-                                            riece-server-alist))))
-                 "\n"
-                 (if (riece-server-process-opened (cdr (car pointer)))
-                     (save-excursion
-                       (set-buffer (process-buffer (cdr (car pointer))))
-                       (goto-char (point-max))
-                       (beginning-of-line -60)
-                       (buffer-substring (point) (point-max)))
-                   "(closed server)"))
-         (setq pointer (cdr pointer))))
-      (insert "\n\nRecent debug messages:\n"
-             "-----------------------------------\n"
-             (with-current-buffer riece-debug-buffer
-               (buffer-string)))
-      ;; Insert recent keystrokes.
-      (insert "\n\nRecent keystrokes:\n"
-             "-----------------\n\n")
-      (let ((before-keys (point)))
-       (insert (key-description recent-keys))
-       (save-restriction
-         (narrow-to-region before-keys (point))
-         (goto-char before-keys)
-         (while (progn (move-to-column 50) (not (eobp)))
-           (search-forward " " nil t)
-           (insert "\n"))))
-      ;; Insert recent minibuffer messages.
-      (insert "\n\nRecent messages (most recent first):\n"
-             "-----------------------------------\n"
-             recent-messages))))
+  (interactive)
+  (browse-url "https://savannah.nongnu.org/bugs/?group=riece"))
 
 (provide 'riece)