comparison lisp/net/rcirc.el @ 68563:979fba30166f

(rcirc-debug): Fix docstring. (rcirc-fill-column, rcirc-receive-message-hooks, rcirc-browse-url-map, rcirc-read-only-flag, rcirc-prompt, rcirc-mode, rcirc-generate-new-buffer-name, rcirc-startup-channels, rcirc-ignore-update-automatic, rcirc-cmd-ignore, rcirc-browse-url, rcirc-url-regexp): Fix typos in docstrings. (rcirc-print): "?\ " -> "?\s".

68562:26cf94e56f83

  :type 'boolean
  :group 'rcirc)

(defcustom rcirc-fill-column nil
  "*Column beyond which automatic line-wrapping should happen.
If nil, use value of `fill-column'.  If frame-width, use the
maximum frame width."
  :type '(choice (const :tag "Value of `fill-column'")
		 (const :tag "Full frame width" frame-width)
		 (integer :tag "Number of columns"))
  :group 'rcirc)

  "*Size of input history ring."
  :type 'integer
  :group 'rcirc)

(defcustom rcirc-read-only-flag t
  "*Non-nil means make text in irc buffers read-only."
  :type 'boolean
  :group 'rcirc)

(defcustom rcirc-buffer-maximum-lines nil
  "*The maximum size in lines for rcirc buffers.

See also `rcirc-authinfo-file-name'."
  :type 'boolean
  :group 'rcirc)

(defcustom rcirc-prompt "> "
  "Prompt string to use in irc buffers.

The following replacements are made:
%n is your nick.
%s is the server.
%t is the buffer target, a channel or a user.

(defvar rcirc-debug-buffer " *rcirc debug*")
(defvar rcirc-debug-flag nil
  "If non-nil, write information to `rcirc-debug-buffer'.")
(defun rcirc-debug (process text)
  "Add an entry to the debug log including PROCESS and TEXT.
Debug text is written to `rcirc-debug-buffer' if `rcirc-debug-p'
is non-nil."
  (when rcirc-debug-flag
    (save-excursion
      (save-window-excursion
        (set-buffer (get-buffer-create rcirc-debug-buffer))

                  (setq ps (cons p ps))))))
          (process-list))
    ps))

(defvar rcirc-receive-message-hooks nil
  "Hook functions run when a message is recieved from server.
Function is called with PROCESS COMMAND SENDER ARGS and LINE.")
(defun rcirc-filter (process output)
  "Called when PROCESS receives OUTPUT."
  (rcirc-debug process output)
  (with-rcirc-process-buffer process
    (setq rcirc-last-server-message-time (current-time))

(define-key global-map (kbd "C-c `") 'rcirc-next-active-buffer)
(define-key global-map (kbd "C-c C-@") 'rcirc-next-active-buffer)
(define-key global-map (kbd "C-c C-SPC") 'rcirc-next-active-buffer)

(defvar rcirc-browse-url-map (make-sparse-keymap)
  "Keymap used ror browsing URLs in `rcirc-mode'.")

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

(defvar rcirc-short-buffer-name nil

(defvar rcirc-mode-hook nil
  "Hook run when setting up rcirc buffer.")

(defun rcirc-mode (process target)
  "Major mode for irc channel buffers.

\\{rcirc-mode-map}"
  (kill-all-local-variables)
  (use-local-map rcirc-mode-map)
  (setq mode-name "rcirc")

(add-hook 'kill-buffer-hook 'rcirc-kill-buffer-hook)

(defun rcirc-generate-new-buffer-name (process target)
  "Return a buffer name based on PROCESS and TARGET.
This is used for the initial name given to irc buffers."
  (if target
      (concat target "@" (process-name process))
    (concat "*" (process-name process) "*")))

(defun rcirc-get-buffer (process target &optional server)

				 ((string= response "ACTION")
				  (+ (length (rcirc-user-nick sender))
				     1))	; [
				 (t 3))		; ***
			   1)
			? )))
		  (fill-column (cond ((eq rcirc-fill-column 'frame-width)
				      (1- (frame-width)))
				     (rcirc-fill-column
				      rcirc-fill-column)
				     (t fill-column))))

	(sit-for 0)			; displayed text before hook
	(run-hook-with-args 'rcirc-print-hooks
			    process sender response target text)))))

(defun rcirc-startup-channels (server)
  "Return the list of startup channels for server."
  (let (channels)
    (dolist (i rcirc-startup-channels-alist)
      (if (string-match (car i) server)
          (setq channels (append channels (cdr i)))))
    channels))

       rcirc-nick-table)
      (mapcar (lambda (x) (car x))
              (sort nicks (lambda (x y) (time-less-p (cdr y) (cdr x))))))))

(defun rcirc-ignore-update-automatic (nick)
  "Remove NICK from  `rcirc-ignore-list'
if NICK is also on  `rcirc-ignore-list-automatic'."
  (when (member nick rcirc-ignore-list-automatic)
      (setq rcirc-ignore-list-automatic
	    (delete nick rcirc-ignore-list-automatic)
	    rcirc-ignore-list
	    (delete nick rcirc-ignore-list))))

(defun-rcirc-command ignore (nick)
  "Manage the ignore list.
Ignore NICK, unignore NICK if already ignored, or list ignored
nicks when no NICK is given.  When listing ignored nicks, the
ones added to the list automatically are marked with an asterix."
  (interactive "sToggle ignoring of nick: ")
  (if (string= "" nick)
      (rcirc-print process (rcirc-nick process) "NOTICE" target 
		   (mapconcat
		    (lambda (nick)
		      (concat nick
			      (if (member nick rcirc-ignore-list-automatic)
				  "*" "")))

(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 URL's.  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: "

(defun rcirc-mangle-text (process text)
  "Return TEXT with properties added based on various patterns."
  ;; ^B
  (setq text
        (rcirc-map-regexp 
	 (lambda (start end string)
	   (let ((orig-face (get-text-property start 'face string)))
	       (add-text-properties
		start end
		(list 'face (if (listp orig-face)
				(append orig-face 
					(list 'bold))
			      (list orig-face 'bold))
		      'rear-nonsticky t)
		string)))
	   ".*?"
	   text))
  ;; TODO: deal with ^_ and ^C colors sequences
  (while (string-match "\\(.*\\)[
]\\(.*\\)" text) 
    (setq text (concat (match-string 1 text)
                       (match-string 2 text))))
  ;; my nick
  (setq text
        (with-syntax-table rcirc-nick-syntax-table

        (rcirc-map-regexp
	 (lambda (start end string)
	   (let ((orig-face (get-text-property start 'face string)))
	     (add-text-properties start end
				  (list 'face (if (listp orig-face)
						  (append orig-face 
							  (list 'bold))
						(list orig-face 'bold))
					'rear-nonsticky t
					'mouse-face 'highlight
					'keymap rcirc-browse-url-map)

(defface rcirc-prompt			; comint-highlight-prompt
  '((((min-colors 88) (background dark)) (:foreground "cyan1"))
    (((background dark)) (:foreground "cyan"))
    (t (:foreground "dark blue")))
  "The face to use to highlight prompts."
  :group 'rcirc-faces)

(defface rcirc-mode-line-nick
  '((t (:bold t)))
  "The face used indicate activity directed at you."

68563:979fba30166f

  :type 'boolean
  :group 'rcirc)

(defcustom rcirc-fill-column nil
  "*Column beyond which automatic line-wrapping should happen.
If nil, use value of `fill-column'.  If 'frame-width, use the
maximum frame width."
  :type '(choice (const :tag "Value of `fill-column'")
		 (const :tag "Full frame width" frame-width)
		 (integer :tag "Number of columns"))
  :group 'rcirc)

  "*Size of input history ring."
  :type 'integer
  :group 'rcirc)

(defcustom rcirc-read-only-flag t
  "*Non-nil means make text in IRC buffers read-only."
  :type 'boolean
  :group 'rcirc)

(defcustom rcirc-buffer-maximum-lines nil
  "*The maximum size in lines for rcirc buffers.

See also `rcirc-authinfo-file-name'."
  :type 'boolean
  :group 'rcirc)

(defcustom rcirc-prompt "> "
  "Prompt string to use in IRC buffers.

The following replacements are made:
%n is your nick.
%s is the server.
%t is the buffer target, a channel or a user.

(defvar rcirc-debug-buffer " *rcirc debug*")
(defvar rcirc-debug-flag nil
  "If non-nil, write information to `rcirc-debug-buffer'.")
(defun rcirc-debug (process text)
  "Add an entry to the debug log including PROCESS and TEXT.
Debug text is written to `rcirc-debug-buffer' if `rcirc-debug-flag'
is non-nil."
  (when rcirc-debug-flag
    (save-excursion
      (save-window-excursion
        (set-buffer (get-buffer-create rcirc-debug-buffer))

                  (setq ps (cons p ps))))))
          (process-list))
    ps))

(defvar rcirc-receive-message-hooks nil
  "Hook functions run when a message is received from server.
Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.")
(defun rcirc-filter (process output)
  "Called when PROCESS receives OUTPUT."
  (rcirc-debug process output)
  (with-rcirc-process-buffer process
    (setq rcirc-last-server-message-time (current-time))

(define-key global-map (kbd "C-c `") 'rcirc-next-active-buffer)
(define-key global-map (kbd "C-c C-@") 'rcirc-next-active-buffer)
(define-key global-map (kbd "C-c C-SPC") 'rcirc-next-active-buffer)

(defvar rcirc-browse-url-map (make-sparse-keymap)
  "Keymap used for browsing URLs in `rcirc-mode'.")

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

(defvar rcirc-short-buffer-name nil

(defvar rcirc-mode-hook nil
  "Hook run when setting up rcirc buffer.")

(defun rcirc-mode (process target)
  "Major mode for IRC channel buffers.

\\{rcirc-mode-map}"
  (kill-all-local-variables)
  (use-local-map rcirc-mode-map)
  (setq mode-name "rcirc")

(add-hook 'kill-buffer-hook 'rcirc-kill-buffer-hook)

(defun rcirc-generate-new-buffer-name (process target)
  "Return a buffer name based on PROCESS and TARGET.
This is used for the initial name given to IRC buffers."
  (if target
      (concat target "@" (process-name process))
    (concat "*" (process-name process) "*")))

(defun rcirc-get-buffer (process target &optional server)

				 ((string= response "ACTION")
				  (+ (length (rcirc-user-nick sender))
				     1))	; [
				 (t 3))		; ***
			   1)
			?\s)))
		  (fill-column (cond ((eq rcirc-fill-column 'frame-width)
				      (1- (frame-width)))
				     (rcirc-fill-column
				      rcirc-fill-column)
				     (t fill-column))))

	(sit-for 0)			; displayed text before hook
	(run-hook-with-args 'rcirc-print-hooks
			    process sender response target text)))))

(defun rcirc-startup-channels (server)
  "Return the list of startup channels for SERVER."
  (let (channels)
    (dolist (i rcirc-startup-channels-alist)
      (if (string-match (car i) server)
          (setq channels (append channels (cdr i)))))
    channels))

       rcirc-nick-table)
      (mapcar (lambda (x) (car x))
              (sort nicks (lambda (x y) (time-less-p (cdr y) (cdr x))))))))

(defun rcirc-ignore-update-automatic (nick)
  "Remove NICK from `rcirc-ignore-list'
if NICK is also on `rcirc-ignore-list-automatic'."
  (when (member nick rcirc-ignore-list-automatic)
      (setq rcirc-ignore-list-automatic
	    (delete nick rcirc-ignore-list-automatic)
	    rcirc-ignore-list
	    (delete nick rcirc-ignore-list))))

(defun-rcirc-command ignore (nick)
  "Manage the ignore list.
Ignore NICK, unignore NICK if already ignored, or list ignored
nicks when no NICK is given.  When listing ignored nicks, the
ones added to the list automatically are marked with an asterisk."
  (interactive "sToggle ignoring of nick: ")
  (if (string= "" nick)
      (rcirc-print process (rcirc-nick process) "NOTICE" target
		   (mapconcat
		    (lambda (nick)
		      (concat nick
			      (if (member nick rcirc-ignore-list-automatic)
				  "*" "")))

(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)
  (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: "

(defun rcirc-mangle-text (process text)
  "Return TEXT with properties added based on various patterns."
  ;; ^B
  (setq text
        (rcirc-map-regexp
	 (lambda (start end string)
	   (let ((orig-face (get-text-property start 'face string)))
	       (add-text-properties
		start end
		(list 'face (if (listp orig-face)
				(append orig-face
					(list 'bold))
			      (list orig-face 'bold))
		      'rear-nonsticky t)
		string)))
	   ".*?"
	   text))
  ;; TODO: deal with ^_ and ^C colors sequences
  (while (string-match "\\(.*\\)[
]\\(.*\\)" text)
    (setq text (concat (match-string 1 text)
                       (match-string 2 text))))
  ;; my nick
  (setq text
        (with-syntax-table rcirc-nick-syntax-table

        (rcirc-map-regexp
	 (lambda (start end string)
	   (let ((orig-face (get-text-property start 'face string)))
	     (add-text-properties start end
				  (list 'face (if (listp orig-face)
						  (append orig-face
							  (list 'bold))
						(list orig-face 'bold))
					'rear-nonsticky t
					'mouse-face 'highlight
					'keymap rcirc-browse-url-map)

(defface rcirc-prompt			; comint-highlight-prompt
  '((((min-colors 88) (background dark)) (:foreground "cyan1"))
    (((background dark)) (:foreground "cyan"))
    (t (:foreground "dark blue")))
  "The face used to highlight prompts."
  :group 'rcirc-faces)

(defface rcirc-mode-line-nick
  '((t (:bold t)))
  "The face used indicate activity directed at you."