Replace Lisp calls to delete-backward-char by delete-char.
[bpt/emacs.git] / lisp / net / rcirc.el
index ef24de4..28ce219 100644 (file)
@@ -1,6 +1,6 @@
 ;;; rcirc.el --- default, simple IRC client.
 
-;; Copyright (C) 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
 
 ;; Author: Ryan Yeske
 ;; URL: http://www.nongnu.org/rcirc
@@ -8,20 +8,18 @@
 
 ;; This file is part of GNU Emacs.
 
-;; This file is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
-;; This file is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 
 ;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -30,7 +28,7 @@
 ;; communication in discussion forums called channels, but also allows
 ;; one-to-one communication.
 
-;; Rcirc has simple defaults and clear and consistent behaviour.
+;; Rcirc has simple defaults and clear and consistent behavior.
 ;; Message arrival timestamps, activity notification on the modeline,
 ;; message filling, nick completion, and keepalive pings are all
 ;; enabled by default, but can easily be adjusted or turned off.  Each
@@ -195,15 +193,16 @@ and a method symbol followed by method specific arguments.
 The valid METHOD symbols are `nickserv', `chanserv' and
 `bitlbee'.
 
-The required ARGUMENTS for each METHOD symbol are:
-  `nickserv': NICK PASSWORD
+The ARGUMENTS for each METHOD symbol are:
+  `nickserv': NICK PASSWORD [NICKSERV-NICK]
   `chanserv': NICK CHANNEL PASSWORD
   `bitlbee': NICK PASSWORD
 
-Example:
+Examples:
  ((\"freenode\" nickserv \"bob\" \"p455w0rd\")
   (\"freenode\" chanserv \"bob\" \"#bobland\" \"passwd99\")
-  (\"bitlbee\" bitlbee \"robert\" \"sekrit\"))"
+  (\"bitlbee\" bitlbee \"robert\" \"sekrit\")
+  (\"dal.net\" nickserv \"bob\" \"sekrit\" \"NickServ@services.dal.net\"))"
   :type '(alist :key-type (string :tag "Server")
                :value-type (choice (list :tag "NickServ"
                                          (const nickserv)
@@ -361,6 +360,15 @@ and the cdr part is used for encoding."
 \f
 (defvar rcirc-startup-channels nil)
 
+(defvar rcirc-server-name-history nil
+  "History variable for \\[rcirc] call.")
+
+(defvar rcirc-server-port-history nil
+  "History variable for \\[rcirc] call.")
+
+(defvar rcirc-nick-name-history nil
+  "History variable for \\[rcirc] call.")
+
 ;;;###autoload
 (defun rcirc (arg)
   "Connect to all servers in `rcirc-server-alist'.
@@ -373,20 +381,23 @@ If ARG is non-nil, instead prompt for connection parameters."
       (let* ((server (completing-read "IRC Server: "
                                      rcirc-server-alist
                                      nil nil
-                                     (caar rcirc-server-alist)))
+                                     (caar rcirc-server-alist)
+                                     'rcirc-server-name-history))
             (server-plist (cdr (assoc-string server rcirc-server-alist)))
             (port (read-string "IRC Port: "
                                (number-to-string
-                                (or (plist-get server-plist 'port)
-                                    rcirc-default-port))))
+                                (or (plist-get server-plist :port)
+                                    rcirc-default-port))
+                               'rcirc-server-port-history))
             (nick (read-string "IRC Nick: "
-                               (or (plist-get server-plist 'nick)
-                                   rcirc-default-nick)))
+                               (or (plist-get server-plist :nick)
+                                   rcirc-default-nick)
+                               'rcirc-nick-name-history))
             (channels (split-string
                        (read-string "IRC Channels: "
                                     (mapconcat 'identity
                                                (plist-get server-plist
-                                                          'channels)
+                                                          :channels)
                                                " "))
                        "[, ]+" t)))
        (rcirc-connect server port nick rcirc-default-user-name
@@ -528,8 +539,10 @@ last ping."
                  (rcirc-send-string process
                                     (format "PRIVMSG %s :\C-aKEEPALIVE %f\C-a"
                                             rcirc-nick
-                                            (time-to-seconds
-                                             (current-time)))))))
+                                             (if (featurep 'xemacs)
+                                                 (time-to-seconds
+                                                  (current-time))
+                                               (float-time)))))))
             (rcirc-process-list))
     ;; no processes, clean up timer
     (cancel-timer rcirc-keepalive-timer)
@@ -537,7 +550,10 @@ last ping."
 
 (defun rcirc-handler-ctcp-KEEPALIVE (process target sender message)
   (with-rcirc-process-buffer process
-    (setq header-line-format (format "%f" (- (time-to-seconds (current-time))
+    (setq header-line-format (format "%f" (- (if (featurep 'xemacs)
+                                                 (time-to-seconds
+                                                  (current-time))
+                                               (float-time))
                                             (string-to-number message))))))
 
 (defvar rcirc-debug-buffer " *rcirc debug*")
@@ -548,8 +564,7 @@ last ping."
 Debug text is written to `rcirc-debug-buffer' if `rcirc-debug-flag'
 is non-nil."
   (when rcirc-debug-flag
-    (save-excursion
-      (set-buffer (get-buffer-create rcirc-debug-buffer))
+    (with-current-buffer (get-buffer-create rcirc-debug-buffer)
       (goto-char (point-max))
       (insert (concat
               "["
@@ -821,6 +836,7 @@ If SILENT is non-nil, do not print the message in any irc buffer."
 
 (define-key rcirc-browse-url-map (kbd "RET") 'rcirc-browse-url-at-point)
 (define-key rcirc-browse-url-map (kbd "<mouse-2>") 'rcirc-browse-url-at-mouse)
+(define-key rcirc-browse-url-map [follow-link] 'mouse-face)
 
 (defvar rcirc-short-buffer-name nil
   "Generated abbreviation to use to indicate buffer activity.")
@@ -1051,8 +1067,8 @@ Create the buffer if it doesn't exist."
     (goto-char (point-max))
     (when (not (equal 0 (- (point) rcirc-prompt-end-marker)))
       ;; delete a trailing newline
-      (when (eq (point) (point-at-bol))
-       (delete-backward-char 1))
+      (when (bolp)
+       (delete-char -1))
       (let ((input (buffer-substring-no-properties
                    rcirc-prompt-end-marker (point))))
        (dolist (line (split-string input "\n"))
@@ -1480,34 +1496,57 @@ record activity."
        (run-hook-with-args 'rcirc-print-hooks
                            process sender response target text)))))
 
+(defcustom rcirc-log-filename-function 'rcirc-generate-new-buffer-name
+  "A function to generate the filename used by rcirc's logging facility.
+
+It is called with two arguments, PROCESS and TARGET (see
+`rcirc-generate-new-buffer-name' for their meaning), and should
+return the filename, or nil if no logging is desired for this
+session.
+
+If the returned filename is absolute (`file-name-absolute-p'
+returns true), then it is used as-is, otherwise the resulting
+file is put into `rcirc-log-directory'."
+  :group 'rcirc
+  :type 'function)
+
 (defun rcirc-log (process sender response target text)
   "Record line in `rcirc-log', to be later written to disk."
-  (let* ((filename (rcirc-generate-new-buffer-name process target))
-        (cell (assoc-string filename rcirc-log-alist))
-        (line (concat (format-time-string rcirc-time-format)
-                      (substring-no-properties
-                       (rcirc-format-response-string process sender
-                                                     response target text))
-                      "\n")))
-    (if cell
-       (setcdr cell (concat (cdr cell) line))
-      (setq rcirc-log-alist
-           (cons (cons filename line) rcirc-log-alist)))))
+  (let ((filename (funcall rcirc-log-filename-function process target)))
+    (unless (null filename)
+      (let ((cell (assoc-string filename rcirc-log-alist))
+           (line (concat (format-time-string rcirc-time-format)
+                         (substring-no-properties
+                          (rcirc-format-response-string process sender
+                                                        response target text))
+                         "\n")))
+       (if cell
+           (setcdr cell (concat (cdr cell) line))
+         (setq rcirc-log-alist
+               (cons (cons filename line) rcirc-log-alist)))))))
 
 (defun rcirc-log-write ()
   "Flush `rcirc-log-alist' data to disk.
 
-Log data is written to `rcirc-log-directory'."
-  (make-directory rcirc-log-directory t)
+Log data is written to `rcirc-log-directory', except for
+log-files with absolute names (see `rcirc-log-filename-function')."
   (dolist (cell rcirc-log-alist)
-    (with-temp-buffer
-      (insert (cdr cell))
-      (let ((coding-system-for-write 'utf-8))
-       (write-region (point-min) (point-max)
-                     (concat rcirc-log-directory "/" (car cell))
-                     t 'quiet))))
+    (let ((filename (expand-file-name (car cell) rcirc-log-directory))
+         (coding-system-for-write 'utf-8))
+      (make-directory (file-name-directory filename) t)
+      (with-temp-buffer
+       (insert (cdr cell))
+       (write-region (point-min) (point-max) filename t 'quiet))))
   (setq rcirc-log-alist nil))
 
+(defun rcirc-view-log-file ()
+  "View logfile corresponding to the current buffer."
+  (interactive)
+  (find-file-other-window 
+   (expand-file-name (funcall rcirc-log-filename-function 
+                             (rcirc-buffer-process) rcirc-target)
+                    rcirc-log-directory)))
+
 (defun rcirc-join-channels (process channels)
   "Join CHANNELS."
   (save-window-excursion
@@ -1598,7 +1637,6 @@ if NICK is also on `rcirc-ignore-list-automatic'."
 (defvar rcirc-track-minor-mode-map (make-sparse-keymap)
   "Keymap for rcirc track minor mode.")
 
-(define-key rcirc-track-minor-mode-map (kbd "C-c `") 'rcirc-next-active-buffer)
 (define-key rcirc-track-minor-mode-map (kbd "C-c C-@") 'rcirc-next-active-buffer)
 (define-key rcirc-track-minor-mode-map (kbd "C-c C-SPC") 'rcirc-next-active-buffer)
 
@@ -1663,9 +1701,9 @@ Uninteresting lines are those whose responses are listed in
   (setq rcirc-omit-mode (not rcirc-omit-mode))
   (if rcirc-omit-mode
       (progn
-       (add-to-invisibility-spec '(rcirc-omit . t))
+       (add-to-invisibility-spec '(rcirc-omit . nil))
        (message "Rcirc-Omit mode enabled"))
-    (remove-from-invisibility-spec '(rcirc-omit . t))
+    (remove-from-invisibility-spec '(rcirc-omit . nil))
     (message "Rcirc-Omit mode disabled"))
     (recenter (when (> (point) rcirc-prompt-start-marker) -1)))
 
@@ -1708,13 +1746,13 @@ With prefix ARG, go to the next low priority buffer with activity."
            (recenter -1)))
       (if (eq major-mode 'rcirc-mode)
          (switch-to-buffer (rcirc-non-irc-buffer))
-       (message (concat
-                 "No IRC activity."
-                 (when lopri
-                   (concat
-                    "  Type C-u "
-                    (key-description (this-command-keys))
-                    " for low priority activity."))))))))
+       (message "%s" (concat
+                      "No IRC activity."
+                      (when lopri
+                        (concat
+                         "  Type C-u "
+                         (key-description (this-command-keys))
+                         " for low priority activity."))))))))
 
 (defvar rcirc-activity-hooks nil
   "Hook to be run when there is channel activity.
@@ -1984,7 +2022,7 @@ activity.  Only run if the buffer is not visible and
   "Display list of names in CHANNEL or in current channel if CHANNEL is nil.
 If called interactively, prompt for a channel when prefix arg is supplied."
   (interactive "P")
-  (if (interactive-p)
+  (if (called-interactively-p 'interactive)
       (if channel
           (setq channel (read-string "List names in channel: " target))))
   (let ((channel (if (> (length channel) 0)
@@ -1996,7 +2034,7 @@ If called interactively, prompt for a channel when prefix arg is supplied."
   "List TOPIC for the TARGET channel.
 With a prefix arg, prompt for new topic."
   (interactive "P")
-  (if (and (interactive-p) topic)
+  (if (and (called-interactively-p 'interactive) topic)
       (setq topic (read-string "New Topic: " rcirc-topic)))
   (rcirc-send-string process (concat "TOPIC " target
                                      (when (> (length topic) 0)
@@ -2122,23 +2160,24 @@ keywords when no KEYWORD is given."
     string))
 
 (defvar rcirc-url-regexp
-  (rx-to-string
-   `(and word-boundary
-        (or (and
-             (or (and (or "http" "https" "ftp" "file" "gopher" "news"
-                          "telnet" "wais" "mailto")
-                      "://")
-                 "www.")
-             (1+ (char "-a-zA-Z0-9_."))
-             (1+ (char "-a-zA-Z0-9_"))
-             (optional ":" (1+ (char "0-9"))))
-            (and (1+ (char "-a-zA-Z0-9_."))
-                 (or ".com" ".net" ".org")
-                 word-boundary))
-        (optional
-         (and "/"
-              (1+ (char "-a-zA-Z0-9_='!?#$\@~`%&*+|\\/:;.,{}[]()"))
-              (char "-a-zA-Z0-9_=#$\@~`%&*+|\\/:;{}[]()")))))
+  (concat
+   "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|"
+   "nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)"
+   "\\(//[-a-z0-9_.]+:[0-9]*\\)?"
+   (if (string-match "[[:digit:]]" "1") ;; Support POSIX?
+       (let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]")
+            (punct "!?:;.,"))
+        (concat
+         "\\(?:"
+         ;; Match paired parentheses, e.g. in Wikipedia URLs:
+         "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" "[" chars "]"
+         "\\|"
+         "[" chars punct     "]+" "[" chars "]"
+         "\\)"))
+     (concat ;; XEmacs 21.4 doesn't support POSIX.
+      "\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+"
+      "\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)"))
+   "\\)")
   "Regexp matching URLs.  Set to nil to disable URL features in rcirc.")
 
 (defun rcirc-browse-url (&optional arg)
@@ -2182,7 +2221,7 @@ keywords when no KEYWORD is given."
     (when (not (eq ?\C-o (char-before (match-end 2))))
       (delete-region (match-beginning 2) (match-end 2)))
     (delete-region (match-beginning 1) (match-end 1))
-    (goto-char (1+ (match-beginning 1))))
+    (goto-char (match-beginning 1)))
   ;; remove the ^O characters now
   (while (re-search-forward "\C-o+" nil t)
     (delete-region (match-beginning 0) (match-end 0))))
@@ -2524,9 +2563,8 @@ Passwords are stored in `rcirc-authinfo' (which see)."
          (cond ((equal method 'nickserv)
                 (rcirc-send-string
                  process
-                 (concat
-                  "PRIVMSG nickserv :identify "
-                  (car args))))
+                 (concat "PRIVMSG " (or (cadr args) "nickserv")
+                          " :identify " (car args))))
                ((equal method 'chanserv)
                 (rcirc-send-string
                  process