comparison lisp/net/rcirc.el @ 83513:966a40e7fb54

Merged from [e-mail] Patches applied: * [e-mail]/emacs--devo--0--patch-234 Update from CVS * [e-mail]/emacs--devo--0--patch-235 Update from CVS * [e-mail]/emacs--devo--0--patch-236 Update from CVS * [e-mail]/emacs--devo--0--patch-237 Update from CVS * [e-mail]/emacs--devo--0--patch-238 Merge from gnus--rel--5.10 * [e-mail]/emacs--devo--0--patch-239 Update from CVS * [e-mail]/emacs--devo--0--patch-240 Update from CVS * [e-mail]/emacs--devo--0--patch-241 Update from CVS * [e-mail]/emacs--devo--0--patch-242 Update from CVS * [e-mail]/emacs--devo--0--patch-243 Update from CVS * [e-mail]/emacs--devo--0--patch-244 Update from CVS * [e-mail]/emacs--devo--0--patch-245 (Ffield_beginning, find_field): Undo change of 2006-04-23. * [e-mail]/emacs--devo--0--patch-246 Update from CVS * [e-mail]/emacs--devo--0--patch-247 Rcirc patch from Ryan Yeske * [e-mail]/emacs--devo--0--patch-248 Update from CVS * [e-mail]/emacs--devo--0--patch-249 Merge from gnus--rel--5.10 * [e-mail]/emacs--devo--0--patch-250 Update from CVS * [e-mail]/emacs--devo--0--patch-251 Update from CVS * [e-mail]/gnus--rel--5.10--patch-87 Merge from emacs--devo--0 * [e-mail]/gnus--rel--5.10--patch-88 Update from CVS * [e-mail]/gnus--rel--5.10--patch-89 Update from CVS * [e-mail]/gnus--rel--5.10--patch-90 Update from CVS * [e-mail]/gnus--rel--5.10--patch-91 Merge from emacs--devo--0 * [e-mail]/gnus--rel--5.10--patch-92 Update from CVS * [e-mail]/gnus--rel--5.10--patch-93 Update from CVS * [e-mail]/gnus--rel--5.10--patch-94 Update from CVS * [e-mail]/gnus--rel--5.10--patch-95 Update from CVS git-archimport-id: [e-mail]--2004/emacs--multi-tty--0--patch-553

83512:5d328dadd0f4

  "Your user name sent to the server when connecting."
  :type 'string
  :group 'rcirc)

(defcustom rcirc-default-user-full-name (if (string= (user-full-name) "")
				 rcirc-user-name
			       (user-full-name))
  "The full name sent to the server when connecting."
  :type 'string
  :group 'rcirc)

(defcustom rcirc-startup-channels-alist '(("^irc.freenode.net$" "#emacs"))
  "Alist of channels to join at startup.
Each element looks like (SERVER-REGEXP . CHANNEL-LIST)."
  :type '(alist :key-type string :value-type (repeat string))
  :group 'rcirc)

  "List of ignored nicks added to `rcirc-ignore-list' because of renaming.
When an ignored person renames, their nick is added to both lists.
Nicks will be removed from the automatic list on follow-up renamings or
parts.")

(defcustom rcirc-print-hooks nil
  "Hook run after text is printed.
Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT."
  :type 'hook
  :group 'rcirc)

(defcustom rcirc-always-use-server-buffer-flag nil
  "Non-nil means messages without a channel target will go to the server buffer."
  :type 'boolean
  :group 'rcirc)

(defcustom rcirc-decode-coding-system 'undecided
  "Coding system used to decode incoming irc messages."
  :type 'coding-system
  :group 'rcirc)

(defcustom rcirc-encode-coding-system 'utf-8

With no argument or nil as argument, use the current buffer."
  (with-current-buffer (or buffer (current-buffer))
    (with-current-buffer rcirc-server-buffer
      (or rcirc-nick rcirc-default-nick))))

(defvar rcirc-max-message-length 450
  "Messages longer than this value will be split.")

(defun rcirc-send-message (process target message &optional noticep)
  "Send TARGET associated with PROCESS a privmsg with text MESSAGE.
If NOTICEP is non-nil, send a notice instead of privmsg."

  :lighter " rcirc-mline"
  :keymap rcirc-multiline-minor-mode-map
  :global nil
  :group 'rcirc
  (make-local-variable 'rcirc-parent-buffer)
  (put 'rcirc-parent-buffer 'permanent-local t))

(defun rcirc-multiline-minor-submit ()
  "Send the text in buffer back to parent buffer."
  (interactive)
  (assert rcirc-parent-buffer)

is found by looking up RESPONSE in `rcirc-response-formats'."
  (let ((chunks
	 (split-string (or (cdr (assoc response rcirc-response-formats))
			   (cdr (assq t rcirc-response-formats)))
		       "%"))
	(result "")
	(face nil)
	key face-key repl)
    (when (equal (car chunks) "")
      (pop chunks))

					 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))

Format based on SENDER and RESPONSE.  If ACTIVITY is non-nil,
record activity."
  (or text (setq text ""))
  (unless (or (member sender rcirc-ignore-list)
	      (member (with-syntax-table rcirc-nick-syntax-table
			(when (string-match "^\\([^/]\\w*\\)\\b" text)
			  (match-string 1 text))) rcirc-ignore-list))
    (let* ((buffer (rcirc-target-buffer process sender response target text))
	   (inhibit-read-only t))
      (with-current-buffer buffer
	(let ((moving (= (point) rcirc-prompt-end-marker))
	      (old-point (point-marker))

	  (let ((nick-match
		 (string-match (concat "\\b"
				       (regexp-quote (rcirc-nick process))
				       "\\b")
			       text)))
	    (when (or (not rcirc-ignore-buffer-activity-flag)
		      ;; always notice when our nick is mentioned, even
		      ;; if ignoring channel activity
		      nick-match)
	      (rcirc-record-activity
	       (current-buffer)
	       (when (or nick-match (and (not (rcirc-channel-p rcirc-target))
					 (not rcirc-low-priority-flag)))
		 'nick)))))

	       "Ignore activity in this buffer"
	     "Notice activity in this buffer"))
  (force-mode-line-update))

(defun rcirc-toggle-low-priority ()
  "Toggle the value of `rcirc-ignore-buffer-activity-flag'."
  (interactive)
  (setq rcirc-low-priority-flag
	(not rcirc-low-priority-flag))
  (message (if rcirc-low-priority-flag
	       "Activity in this buffer is low priority"

	       (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)
  (let ((completions (mapcar (lambda (x) (cons x nil)) rcirc-urls))
        (initial-input (car rcirc-urls))
        (history (cdr rcirc-urls)))
    (browse-url (completing-read "rcirc browse-url: "
                                 completions nil nil initial-input 'history)

				     (match-string 1 message))
      (rcirc-print process sender "NOTICE"
		   (cond ((rcirc-channel-p target)
			  target)
			 ;;; -ChanServ- [#gnu] Welcome...
			 ((string-match "^\\[\\(#[^ ]+\\)\\]" message)
			  (match-string 1 message))
			 (sender
			  (if (string= sender (rcirc-server-name process))
			      nil	; server notice
			    sender)))

    (((class color) (min-colors 8)) (:foreground "yellow" :weight light))
    (t (:weight bold :slant italic)))
  "The face used to highlight other messages."
  :group 'rcirc-faces)

(defface rcirc-server			; font-lock-comment-face
  '((((class grayscale) (background light))
     (:foreground "DimGray" :weight bold :slant italic))
    (((class grayscale) (background dark))
     (:foreground "LightGray" :weight bold :slant italic))

83513:966a40e7fb54

  "Your user name sent to the server when connecting."
  :type 'string
  :group 'rcirc)

(defcustom rcirc-default-user-full-name (if (string= (user-full-name) "")
					    rcirc-user-name
					  (user-full-name))
  "The full name sent to the server when connecting."
  :type 'string
  :group 'rcirc)

(defcustom rcirc-startup-channels-alist '(("^irc.freenode.net$" "#rcirc"))
  "Alist of channels to join at startup.
Each element looks like (SERVER-REGEXP . CHANNEL-LIST)."
  :type '(alist :key-type string :value-type (repeat string))
  :group 'rcirc)

  "List of ignored nicks added to `rcirc-ignore-list' because of renaming.
When an ignored person renames, their nick is added to both lists.
Nicks will be removed from the automatic list on follow-up renamings or
parts.")

(defcustom rcirc-bright-nick-regexp nil
  "Regexp matching nicks to be emphasized.
See `rcirc-bright-nick' face."
  :type 'regexp
  :group 'rcirc)

(defcustom rcirc-dim-nick-regexp nil
  "Regexp matching nicks to be deemphasized.
See `rcirc-dim-nick' face."
  :type 'regexp
  :group 'rcirc)

(defcustom rcirc-print-hooks nil
  "Hook run after text is printed.
Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT."
  :type 'hook
  :group 'rcirc)

(defcustom rcirc-always-use-server-buffer-flag nil
  "Non-nil means messages without a channel target will go to the server buffer."
  :type 'boolean
  :group 'rcirc)

(defcustom rcirc-decode-coding-system 'utf-8
  "Coding system used to decode incoming irc messages."
  :type 'coding-system
  :group 'rcirc)

(defcustom rcirc-encode-coding-system 'utf-8

With no argument or nil as argument, use the current buffer."
  (with-current-buffer (or buffer (current-buffer))
    (with-current-buffer rcirc-server-buffer
      (or rcirc-nick rcirc-default-nick))))

(defvar rcirc-max-message-length 420
  "Messages longer than this value will be split.")

(defun rcirc-send-message (process target message &optional noticep)
  "Send TARGET associated with PROCESS a privmsg with text MESSAGE.
If NOTICEP is non-nil, send a notice instead of privmsg."

  :lighter " rcirc-mline"
  :keymap rcirc-multiline-minor-mode-map
  :global nil
  :group 'rcirc
  (make-local-variable 'rcirc-parent-buffer)
  (put 'rcirc-parent-buffer 'permanent-local t)
  (setq fill-column rcirc-max-message-length))

(defun rcirc-multiline-minor-submit ()
  "Send the text in buffer back to parent buffer."
  (interactive)
  (assert rcirc-parent-buffer)

is found by looking up RESPONSE in `rcirc-response-formats'."
  (let ((chunks
	 (split-string (or (cdr (assoc response rcirc-response-formats))
			   (cdr (assq t rcirc-response-formats)))
		       "%"))
	(sender (or sender ""))
	(result "")
	(face nil)
	key face-key repl)
    (when (equal (car chunks) "")
      (pop chunks))

					 sender)
				       (and target (concat "," target)))))
		     (rcirc-facify nick
				   (if (eq key ?n)
				       face
				     (cond ((string= sender (rcirc-nick process))
					    'rcirc-my-nick)
					   ((and rcirc-bright-nick-regexp
						 (string-match rcirc-bright-nick-regexp sender))
					    'rcirc-bright-nick)
					   ((and rcirc-dim-nick-regexp
						 (string-match rcirc-dim-nick-regexp sender))
					    'rcirc-dim-nick)
					   (t
					    'rcirc-other-nick))))))
		  ((eq key ?T)
		   ;; %T -- timestamp
		   (rcirc-facify
		    (format-time-string rcirc-time-format (current-time))
		    'rcirc-timestamp))

Format based on SENDER and RESPONSE.  If ACTIVITY is non-nil,
record activity."
  (or text (setq text ""))
  (unless (or (member sender rcirc-ignore-list)
	      (member (with-syntax-table rcirc-nick-syntax-table
			(when (string-match "^\\([^/]\\w*\\)[:,]" text)
			  (match-string 1 text)))
		      rcirc-ignore-list))
    (let* ((buffer (rcirc-target-buffer process sender response target text))
	   (inhibit-read-only t))
      (with-current-buffer buffer
	(let ((moving (= (point) rcirc-prompt-end-marker))
	      (old-point (point-marker))

	  (let ((nick-match
		 (string-match (concat "\\b"
				       (regexp-quote (rcirc-nick process))
				       "\\b")
			       text)))
	    (when (if rcirc-ignore-buffer-activity-flag
		      ;; - Always notice when our nick is mentioned
		      nick-match
		    ;; - Never bother us if a dim-nick spoke
		    (not (and rcirc-dim-nick-regexp sender
			      (string-match rcirc-dim-nick-regexp sender))))
	      (rcirc-record-activity
	       (current-buffer)
	       (when (or nick-match (and (not (rcirc-channel-p rcirc-target))
					 (not rcirc-low-priority-flag)))
		 'nick)))))

	       "Ignore activity in this buffer"
	     "Notice activity in this buffer"))
  (force-mode-line-update))

(defun rcirc-toggle-low-priority ()
  "Toggle the value of `rcirc-low-priority-flag'."
  (interactive)
  (setq rcirc-low-priority-flag
	(not rcirc-low-priority-flag))
  (message (if rcirc-low-priority-flag
	       "Activity in this buffer is low priority"

	       (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 "P")
  (let ((completions (mapcar (lambda (x) (cons x nil)) rcirc-urls))
        (initial-input (car rcirc-urls))
        (history (cdr rcirc-urls)))
    (browse-url (completing-read "rcirc browse-url: "
                                 completions nil nil initial-input 'history)

				     (match-string 1 message))
      (rcirc-print process sender "NOTICE"
		   (cond ((rcirc-channel-p target)
			  target)
			 ;;; -ChanServ- [#gnu] Welcome...
			 ((string-match "\\[\\(#[^\] ]+\\)\\]" message)
			  (match-string 1 message))
			 (sender
			  (if (string= sender (rcirc-server-name process))
			      nil	; server notice
			    sender)))

    (((class color) (min-colors 8)) (:foreground "yellow" :weight light))
    (t (:weight bold :slant italic)))
  "The face used to highlight other messages."
  :group 'rcirc-faces)

(defface rcirc-bright-nick
  '((((class grayscale) (background light))
     (:foreground "LightGray" :weight bold :underline t))
    (((class grayscale) (background dark))
     (:foreground "Gray50" :weight bold :underline t))
    (((class color) (min-colors 88) (background light)) (:foreground "CadetBlue"))
    (((class color) (min-colors 88) (background dark)) (:foreground "Aquamarine"))
    (((class color) (min-colors 16) (background light)) (:foreground "CadetBlue"))
    (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine"))
    (((class color) (min-colors 8)) (:foreground "magenta"))
    (t (:weight bold :underline t)))
  "Face used for nicks matched by `rcirc-bright-nick-regexp'."
  :group 'rcirc-faces)

(defface rcirc-dim-nick
  '((t :inherit default))
  "Face used for nicks matched by `rcirc-dim-nick-regexp'."
  :group 'rcirc-faces)

(defface rcirc-server			; font-lock-comment-face
  '((((class grayscale) (background light))
     (:foreground "DimGray" :weight bold :slant italic))
    (((class grayscale) (background dark))
     (:foreground "LightGray" :weight bold :slant italic))