comparison lisp/net/rcirc.el @ 68960:6e3160901812

(rcirc-connect): Make all arguments optional, and default to global variable values for unsupplied args. (rcirc-get-buffer-create): Fix bug with setting the target. (rcirc-any-buffer): Rename from rcirc-get-any-buffer, and include test for rcirc-always-use-server-buffer-flag here. (rcirc-response-formats): Add %N, which is a facified nick. %n uses the default face. Change the ACTION format string. If the "nick" is the server, don't print anything for that field. Comment fixes. (rcirc-target-buffer): Don't test rcirc-always-use-server-buffer-flag here. (rcirc-print): Squeeze extra spaces out of the text before message. (rcirc-put-nick-channel): Strip potential "@" char from nick before adding them to nick table. (rcirc-url-regexp): Improve to match address like "foo.com".

68959:ba7509deaeff

(eval-when-compile (require 'cl))

(defgroup rcirc nil
  "Simple IRC client."
  :version "22.1"
  :prefix "rcirc"
  :group 'applications)

(defcustom rcirc-server "irc.freenode.net"
  "The default server to connect to."
  :type 'string


(defvar rcirc-process-output nil)
(defvar rcirc-topic nil)
(defvar rcirc-keepalive-timer nil)
(defvar rcirc-last-server-message-time nil)
(defun rcirc-connect (server port nick user-name full-name startup-channels)
  (add-hook 'window-configuration-change-hook
	    'rcirc-window-configuration-change)

  (save-excursion
    (message "Connecting to %s..." server)
    (let* ((inhibit-eol-conversion)
           (port-number (if (stringp port)
                            (string-to-number port)
                          port))
           (process (open-network-stream server nil server port-number)))
      ;; set up process
      (set-process-coding-system process 'raw-text 'raw-text)
      (set-process-filter process 'rcirc-filter)
      (switch-to-buffer (rcirc-generate-new-buffer-name process nil))

(defun rcirc-get-buffer-create (process target)
  "Return the buffer associated with the PROCESS and TARGET.
Create the buffer if it doesn't exist."
  (let ((buffer (rcirc-get-buffer process target)))
    (if buffer
	(progn
	  (when (not rcirc-target)
	    (setq rcirc-target target))
	  buffer)
	;; create the buffer
	(with-rcirc-process-buffer process
	  (let ((new-buffer (get-buffer-create
			     (rcirc-generate-new-buffer-name process target))))

  (interactive)
  (assert (and (eq major-mode 'rcirc-multiline-edit-mode)))
  (kill-buffer (current-buffer))
  (set-window-configuration rcirc-window-configuration))

(defun rcirc-get-any-buffer (process)
  "Return a buffer for PROCESS, either the one selected or the process buffer."
  (let ((buffer (window-buffer (selected-window))))
    (if (and buffer
	     (with-current-buffer buffer
	       (and (eq major-mode 'rcirc-mode)
		    (eq rcirc-process process))))
	buffer
      (process-buffer process))))

(defcustom rcirc-response-formats
  '(("PRIVMSG" . "%T<%n> %m")
    ("NOTICE"  . "%T-%n- %m")
    ("ACTION"  . "%T[%n] %m")
    ("COMMAND" . "%T%m")
    ("ERROR"   . "%T%fw!!! %m")
    (t         . "%T%fp*** %fs%n %r %m"))
  "An alist of formats used for printing responses.
The format is looked up using the response-type as a key;

The entry's value part should be a string, which is inserted with
the of the following escape sequences replaced by the described values:

  %m        The message text
  %n        The sender's nick (with face `rcirc-my-nick' or `rcirc-other-nick')
  %r        The response-type
  %T        The timestamp (with face `rcirc-timestamp')
  %t        The target
  %fw       Following text uses the face `font-lock-warning-face'
  %fp       Following text uses the face `rcirc-server-prefix'

	(setq chunk (substring chunk 1)))
      (setq repl
	    (cond ((eq key ?%)
		   ;; %% -- literal % character
		   "%")
		  ((eq key ?n)
		   ;; %n -- nick
		   (rcirc-facify (concat (rcirc-abbrev-nick sender)
					 (and target (concat "," target)))
				 (if (string= sender (rcirc-nick process))
				     'rcirc-my-nick
				   'rcirc-other-nick)))
		  ((eq key ?T)
		   ;; %T -- timestamp
		   (rcirc-facify
		    (format-time-string rcirc-time-format (current-time))
		    'rcirc-timestamp))

(defun rcirc-target-buffer (process sender response target text)
  "Return a buffer to print the server response."
  (assert (not (bufferp target)))
  (with-rcirc-process-buffer process
    (cond ((not target)
	   (if rcirc-always-use-server-buffer-flag
	       (process-buffer process)
	     (rcirc-get-any-buffer process)))
	  ((not (rcirc-channel-p target))
	   ;; message from another user
	   (if (string= response "PRIVMSG")
	       (rcirc-get-buffer-create process (if (string= sender rcirc-nick)
						    target
						  sender))
	     (rcirc-get-buffer process target t)))
	  ((or (rcirc-get-buffer process target)
	       (rcirc-get-any-buffer process))))))

(defvar rcirc-activity-type nil)
(make-variable-buffer-local 'rcirc-activity-type)
(defun rcirc-print (process sender response target text &optional activity)
  "Print TEXT in the buffer associated with TARGET.

	    (insert fmted-text (propertize "\n" 'hard t))
	    (set-marker-insertion-type rcirc-prompt-start-marker nil)
	    (set-marker-insertion-type rcirc-prompt-end-marker nil)

	    ;; fill the text we just inserted, maybe
	    (when (and rcirc-fill-flag
		       (not (string= response "372"))) ;/motd
	      (let ((fill-prefix
		     (or rcirc-fill-prefix
			 (make-string
			  (or (next-single-property-change 0 'rcirc-text
							   fmted-text)
			      8)
			  ?\s)))
		    (fill-column (cond ((eq rcirc-fill-column 'frame-width)
					(1- (frame-width)))
				       (rcirc-fill-column
					rcirc-fill-column)
				       (t fill-column))))
		(fill-region fill-start rcirc-prompt-start-marker 'left t))))

	  ;; set inserted text to be read-only
	  (when rcirc-read-only-flag
	    (put-text-property rcirc-prompt-start-marker fill-start 'read-only t)
	    (let ((inhibit-read-only t))

    (mapcar (lambda (x) (car x))
	    (gethash nick rcirc-nick-table))))

(defun rcirc-put-nick-channel (process nick channel)
  "Add CHANNEL to list associated with NICK."
  (with-rcirc-process-buffer process
    (let* ((chans (gethash nick rcirc-nick-table))
	   (record (assoc-string channel chans t)))
      (if record
          (setcdr record (current-time))
        (puthash nick (cons (cons channel (current-time))
                            chans)
                 rcirc-nick-table)))))

(defun rcirc-nick-remove (process nick)
  "Remove NICK from table."
  (with-rcirc-process-buffer process
    (remhash nick rcirc-nick-table)))

(defun rcirc-facify (string face)
  "Return a copy of STRING with FACE property added."
  (propertize (or string "") 'face face 'rear-nonsticky t))

(defvar rcirc-url-regexp
  (rx word-boundary
      (or "www."
	  (and (or "http" "https" "ftp" "file" "gopher" "news" "telnet" "wais"
		   "mailto")
	       "://"
	       (1+ (char "a-zA-Z0-9_."))
	       (optional ":" (1+ (char "0-9")))))
      (1+ (char "-a-zA-Z0-9_=!?#$\@~`%&*+|\\/:;.,{}[]"))
      (char "-a-zA-Z0-9_=#$\@~`%&*+|\\/:;{}[]"))
  "Regexp matching URLs.  Set to nil to disable URL features in rcirc.")

(defun rcirc-browse-url (&optional arg)
  "Prompt for URL to browse based on URLs in buffer."
  (interactive)

68960:6e3160901812

(eval-when-compile (require 'cl))

(defgroup rcirc nil
  "Simple IRC client."
  :version "22.1"
  :prefix "rcirc-"
  :group 'applications)

(defcustom rcirc-server "irc.freenode.net"
  "The default server to connect to."
  :type 'string


(defvar rcirc-process-output nil)
(defvar rcirc-topic nil)
(defvar rcirc-keepalive-timer nil)
(defvar rcirc-last-server-message-time nil)
(defun rcirc-connect (&optional server port nick user-name full-name startup-channels)
  (add-hook 'window-configuration-change-hook
	    'rcirc-window-configuration-change)

  (save-excursion
    (message "Connecting to %s..." server)
    (let* ((inhibit-eol-conversion)
           (port-number (if port
			    (if (stringp port)
				(string-to-number port)
			      port)
			  rcirc-port))
	   (server (or server rcirc-server))
	   (nick (or nick rcirc-nick))
	   (user-name (or user-name rcirc-user-name))
	   (full-name (or full-name rcirc-user-full-name))
	   (startup-channels (or startup-channels (rcirc-startup-channels server)))
           (process (open-network-stream server nil server port-number)))
      ;; set up process
      (set-process-coding-system process 'raw-text 'raw-text)
      (set-process-filter process 'rcirc-filter)
      (switch-to-buffer (rcirc-generate-new-buffer-name process nil))

(defun rcirc-get-buffer-create (process target)
  "Return the buffer associated with the PROCESS and TARGET.
Create the buffer if it doesn't exist."
  (let ((buffer (rcirc-get-buffer process target)))
    (if buffer
	(with-current-buffer buffer
	  (when (not rcirc-target)
 	    (setq rcirc-target target))
	  buffer)
	;; create the buffer
	(with-rcirc-process-buffer process
	  (let ((new-buffer (get-buffer-create
			     (rcirc-generate-new-buffer-name process target))))

  (interactive)
  (assert (and (eq major-mode 'rcirc-multiline-edit-mode)))
  (kill-buffer (current-buffer))
  (set-window-configuration rcirc-window-configuration))

(defun rcirc-any-buffer (process)
  "Return a buffer for PROCESS, either the one selected or the process buffer."
  (if rcirc-always-use-server-buffer-flag
      (process-buffer process)
    (let ((buffer (window-buffer (selected-window))))
      (if (and buffer
	       (with-current-buffer buffer
		 (and (eq major-mode 'rcirc-mode)
		      (eq rcirc-process process))))
	  buffer
	(process-buffer process)))))

(defcustom rcirc-response-formats
  '(("PRIVMSG" . "%T<%N> %m")
    ("NOTICE"  . "%T-%N- %m")
    ("ACTION"  . "%T[%N %m]")
    ("COMMAND" . "%T%m")
    ("ERROR"   . "%T%fw!!! %m")
    (t         . "%T%fp*** %fs%n %r %m"))
  "An alist of formats used for printing responses.
The format is looked up using the response-type as a key;

The entry's value part should be a string, which is inserted with
the of the following escape sequences replaced by the described values:

  %m        The message text
  %n        The sender's nick
  %N        The sender's nick (with face `rcirc-my-nick' or `rcirc-other-nick')
  %r        The response-type
  %T        The timestamp (with face `rcirc-timestamp')
  %t        The target
  %fw       Following text uses the face `font-lock-warning-face'
  %fp       Following text uses the face `rcirc-server-prefix'

	(setq chunk (substring chunk 1)))
      (setq repl
	    (cond ((eq key ?%)
		   ;; %% -- literal % character
		   "%")
		  ((or (eq key ?n) (eq key ?N))
		   ;; %n/%N -- nick
		   (let ((nick (concat (if (string= (with-rcirc-process-buffer
							process rcirc-server)
						    sender)
					   ""
					 (rcirc-abbrev-nick sender))
				       (and target (concat "," target)))))
		     (rcirc-facify nick
				   (if (eq key ?n)
				       face
				     (if (string= sender (rcirc-nick process))
					 'rcirc-my-nick
				       'rcirc-other-nick)))))
		  ((eq key ?T)
		   ;; %T -- timestamp
		   (rcirc-facify
		    (format-time-string rcirc-time-format (current-time))
		    'rcirc-timestamp))

(defun rcirc-target-buffer (process sender response target text)
  "Return a buffer to print the server response."
  (assert (not (bufferp target)))
  (with-rcirc-process-buffer process
    (cond ((not target)
	   (rcirc-any-buffer process))
	  ((not (rcirc-channel-p target))
	   ;; message from another user
	   (if (string= response "PRIVMSG")
	       (rcirc-get-buffer-create process (if (string= sender rcirc-nick)
						    target
						  sender))
	     (rcirc-get-buffer process target t)))
	  ((or (rcirc-get-buffer process target)
	       (rcirc-any-buffer process))))))

(defvar rcirc-activity-type nil)
(make-variable-buffer-local 'rcirc-activity-type)
(defun rcirc-print (process sender response target text &optional activity)
  "Print TEXT in the buffer associated with TARGET.

	    (insert fmted-text (propertize "\n" 'hard t))
	    (set-marker-insertion-type rcirc-prompt-start-marker nil)
	    (set-marker-insertion-type rcirc-prompt-end-marker nil)

	    (let ((text-start (make-marker)))
	      (set-marker text-start
			  (or (next-single-property-change fill-start 
							   'rcirc-text)
			      (point-max)))
	      ;; squeeze spaces out of text before rcirc-text
	      (fill-region fill-start (1- text-start))

	      ;; fill the text we just inserted, maybe
	      (when (and rcirc-fill-flag
			 (not (string= response "372"))) ;/motd
		(let ((fill-prefix
		       (or rcirc-fill-prefix
			   (make-string (- text-start fill-start) ?\s)))
		      (fill-column (cond ((eq rcirc-fill-column 'frame-width)
					  (1- (frame-width)))
					 (rcirc-fill-column
					  rcirc-fill-column)
					 (t fill-column))))
		  (fill-region fill-start rcirc-prompt-start-marker 'left t)))))

	  ;; set inserted text to be read-only
	  (when rcirc-read-only-flag
	    (put-text-property rcirc-prompt-start-marker fill-start 'read-only t)
	    (let ((inhibit-read-only t))

    (mapcar (lambda (x) (car x))
	    (gethash nick rcirc-nick-table))))

(defun rcirc-put-nick-channel (process nick channel)
  "Add CHANNEL to list associated with NICK."
  (let ((nick (rcirc-user-nick nick)))
    (with-rcirc-process-buffer process
      (let* ((chans (gethash nick rcirc-nick-table))
	     (record (assoc-string channel chans t)))
	(if record
	    (setcdr record (current-time))
	  (puthash nick (cons (cons channel (current-time))
			      chans)
		   rcirc-nick-table))))))

(defun rcirc-nick-remove (process nick)
  "Remove NICK from table."
  (with-rcirc-process-buffer process
    (remhash nick rcirc-nick-table)))

(defun rcirc-facify (string face)
  "Return a copy of STRING with FACE property added."
  (propertize (or string "") 'face face 'rear-nonsticky t))

(defvar rcirc-url-regexp
  (rx-to-string
   `(and word-boundary
	 (or "www."
	     (and (or "http" "https" "ftp" "file" "gopher" "news" "telnet" 
		      "wais" "mailto")
		  "://"
		  (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_=#$\@~`%&*+|\\/:;{}[]")))))
  "Regexp matching URLs.  Set to nil to disable URL features in rcirc.")

(defun rcirc-browse-url (&optional arg)
  "Prompt for URL to browse based on URLs in buffer."
  (interactive)