;;; rcirc.el --- default, simple IRC client.
-;; Copyright (C) 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2012 Free Software Foundation, Inc.
;; Author: Ryan Yeske <rcyeske@gmail.com>
;; Maintainers: Ryan Yeske <rcyeske@gmail.com>,
:group 'applications)
(defcustom rcirc-server-alist
- '(("irc.freenode.net" :channels ("#rcirc")))
+ '(("irc.freenode.net" :channels ("#rcirc")
+ ;; Don't use the TLS port by default, in case gnutls is not available.
+ ;; :port 7000 :encryption tls
+ ))
"An alist of IRC connections to establish when running `rcirc'.
Each element looks like (SERVER-NAME PARAMETERS).
VALUE must be a list of strings describing which channels to join
when connecting to this server. If absent, no channels will be
-connected to automatically."
+connected to automatically.
+
+`:encryption'
+
+VALUE must be `plain' (the default) for unencrypted connections, or `tls'
+for connections using SSL/TLS."
:type '(alist :key-type string
- :value-type (plist :options ((:nick string)
- (:port integer)
- (:user-name string)
- (:password string)
- (:full-name string)
- (:channels (repeat string)))))
+ :value-type (plist :options
+ ((:nick string)
+ (:port integer)
+ (:user-name string)
+ (:password string)
+ (:full-name string)
+ (:channels (repeat string))
+ (:encryption (choice (const tls)
+ (const plain))))))
:group 'rcirc)
(defcustom rcirc-default-port 6667
:group 'rcirc)
(defcustom rcirc-decode-coding-system 'utf-8
- "Coding system used to decode incoming irc messages."
+ "Coding system used to decode incoming irc messages.
+Set to 'undecided if you want the encoding of the incoming
+messages autodetected."
:type 'coding-system
:group 'rcirc)
(plist-get server-plist
:channels)
" "))
- "[, ]+" t)))
+ "[, ]+" t))
+ (encryption (rcirc-prompt-for-encryption server-plist)))
(rcirc-connect server port nick user-name
rcirc-default-full-name
- channels password))
+ channels password encryption))
;; connect to servers in `rcirc-server-alist'
(let (connected-servers)
(dolist (c rcirc-server-alist)
(full-name (or (plist-get (cdr c) :full-name)
rcirc-default-full-name))
(channels (plist-get (cdr c) :channels))
- (password (plist-get (cdr c) :password)))
+ (password (plist-get (cdr c) :password))
+ (encryption (plist-get (cdr c) :encryption)))
(when server
(let (connected)
(dolist (p (rcirc-process-list))
(if (not connected)
(condition-case e
(rcirc-connect server port nick user-name
- full-name channels password)
+ full-name channels password encryption)
(quit (message "Quit connecting to %s" server)))
(with-current-buffer (process-buffer connected)
(setq connected-servers
;;;###autoload
(defun rcirc-connect (server &optional port nick user-name
- full-name startup-channels password)
+ full-name startup-channels password encryption)
(save-excursion
(message "Connecting to %s..." server)
(let* ((inhibit-eol-conversion)
(user-name (or user-name rcirc-default-user-name))
(full-name (or full-name rcirc-default-full-name))
(startup-channels startup-channels)
- (process (make-network-process :name server :host server :service port-number)))
+ (process (open-network-stream
+ server nil server port-number
+ :type (or encryption 'plain))))
;; set up process
(set-process-coding-system process 'raw-text 'raw-text)
(switch-to-buffer (rcirc-generate-new-buffer-name process nil))
(rcirc-mode process nil)
(set-process-sentinel process 'rcirc-sentinel)
(set-process-filter process 'rcirc-filter)
- (make-local-variable 'rcirc-process)
- (setq rcirc-process process)
- (make-local-variable 'rcirc-server)
- (setq rcirc-server server)
- (make-local-variable 'rcirc-server-name)
- (setq rcirc-server-name server) ; update when we get 001 response
- (make-local-variable 'rcirc-buffer-alist)
- (setq rcirc-buffer-alist nil)
- (make-local-variable 'rcirc-nick-table)
- (setq rcirc-nick-table (make-hash-table :test 'equal))
- (make-local-variable 'rcirc-nick)
- (setq rcirc-nick nick)
- (make-local-variable 'rcirc-process-output)
- (setq rcirc-process-output nil)
- (make-local-variable 'rcirc-startup-channels)
- (setq rcirc-startup-channels startup-channels)
- (make-local-variable 'rcirc-last-server-message-time)
- (setq rcirc-last-server-message-time (current-time))
- (make-local-variable 'rcirc-timeout-timer)
- (setq rcirc-timeout-timer nil)
- (make-local-variable 'rcirc-user-disconnect)
- (setq rcirc-user-disconnect nil)
- (make-local-variable 'rcirc-user-authenticated)
- (setq rcirc-user-authenticated nil)
- (make-local-variable 'rcirc-connecting)
- (setq rcirc-connecting t)
+
+ (set (make-local-variable 'rcirc-process) process)
+ (set (make-local-variable 'rcirc-server) server)
+ (set (make-local-variable 'rcirc-server-name) server) ; Update when we get 001 response.
+ (set (make-local-variable 'rcirc-buffer-alist) nil)
+ (set (make-local-variable 'rcirc-nick-table)
+ (make-hash-table :test 'equal))
+ (set (make-local-variable 'rcirc-nick) nick)
+ (set (make-local-variable 'rcirc-process-output) nil)
+ (set (make-local-variable 'rcirc-startup-channels) startup-channels)
+ (set (make-local-variable 'rcirc-last-server-message-time)
+ (current-time))
+
+ (set (make-local-variable 'rcirc-timeout-timer) nil)
+ (set (make-local-variable 'rcirc-user-disconnect) nil)
+ (set (make-local-variable 'rcirc-user-authenticated) nil)
+ (set (make-local-variable 'rcirc-connecting) t)
(add-hook 'auto-save-hook 'rcirc-log-write)
(time-to-seconds (current-time))
(float-time)))
+(defun rcirc-prompt-for-encryption (server-plist)
+ "Prompt the user for the encryption method to use.
+SERVER-PLIST is the property list for the server."
+ (let ((msg "Encryption (default %s): ")
+ (choices '("plain" "tls"))
+ (default (or (plist-get server-plist :encryption)
+ 'plain)))
+ (intern
+ (completing-read (format msg default)
+ choices nil t nil nil (symbol-name default)))))
+
(defun rcirc-keepalive ()
"Send keep alive pings to active rcirc processes.
Kill processes that have not received a server message since the
(setq header-line-format (format "%f" (- (rcirc-float-time)
(string-to-number message))))))
-(defvar rcirc-debug-buffer " *rcirc debug*")
+(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)
(defun rcirc-disconnect-buffer (&optional buffer)
(with-current-buffer (or buffer (current-buffer))
;; set rcirc-target to nil for each channel so cleanup
- ;; doesnt happen when we reconnect
+ ;; doesn't happen when we reconnect
(setq rcirc-target nil)
(setq mode-line-process ":disconnected")))
(mapconcat 'identity (cdr args) " ")
(not (member response rcirc-responses-no-activity))))
+(defun rcirc--connection-open-p (process)
+ (memq (process-status process) '(run open)))
+
(defun rcirc-send-string (process string)
"Send PROCESS a STRING plus a newline."
(let ((string (concat (encode-coding-string string rcirc-encode-coding-system)
"\n")))
- (unless (eq (process-status process) 'open)
+ (unless (rcirc--connection-open-p process)
(error "Network connection to %s is not open"
(process-name process)))
(rcirc-debug process string)
(defvar rcirc-input-ring nil)
(defvar rcirc-input-ring-index 0)
+
(defun rcirc-prev-input-string (arg)
(ring-ref rcirc-input-ring (+ rcirc-input-ring-index arg)))
-(defun rcirc-insert-prev-input (arg)
- (interactive "p")
+(defun rcirc-insert-prev-input ()
+ (interactive)
(when (<= rcirc-prompt-end-marker (point))
(delete-region rcirc-prompt-end-marker (point-max))
(insert (rcirc-prev-input-string 0))
(setq rcirc-input-ring-index (1+ rcirc-input-ring-index))))
-(defun rcirc-insert-next-input (arg)
- (interactive "p")
+(defun rcirc-insert-next-input ()
+ (interactive)
(when (<= rcirc-prompt-end-marker (point))
(delete-region rcirc-prompt-end-marker (point-max))
(setq rcirc-input-ring-index (1- rcirc-input-ring-index))
(defun set-rcirc-decode-coding-system (coding-system)
"Set the decode coding system used in this channel."
(interactive "zCoding system for incoming messages: ")
- (setq rcirc-decode-coding-system coding-system))
+ (set (make-local-variable 'rcirc-decode-coding-system) coding-system))
(defun set-rcirc-encode-coding-system (coding-system)
"Set the encode coding system used in this channel."
(interactive "zCoding system for outgoing messages: ")
- (setq rcirc-encode-coding-system coding-system))
+ (set (make-local-variable 'rcirc-encode-coding-system) coding-system))
(defvar rcirc-mode-map
(let ((map (make-sparse-keymap)))
map)
"Keymap for rcirc mode.")
-(defvar rcirc-browse-url-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "RET") 'rcirc-browse-url-at-point)
- (define-key map (kbd "<mouse-2>") 'rcirc-browse-url-at-mouse)
- (define-key map [follow-link] 'mouse-face)
- map)
- "Keymap used for browsing URLs in `rcirc-mode'.")
-
(defvar rcirc-short-buffer-name nil
"Generated abbreviation to use to indicate buffer activity.")
(setq major-mode 'rcirc-mode)
(setq mode-line-process nil)
- (make-local-variable 'rcirc-input-ring)
- (setq rcirc-input-ring (make-ring rcirc-input-ring-size))
- (make-local-variable 'rcirc-server-buffer)
- (setq rcirc-server-buffer (process-buffer process))
- (make-local-variable 'rcirc-target)
- (setq rcirc-target target)
- (make-local-variable 'rcirc-topic)
- (setq rcirc-topic nil)
- (make-local-variable 'rcirc-last-post-time)
- (setq rcirc-last-post-time (current-time))
- (make-local-variable 'fill-paragraph-function)
- (setq fill-paragraph-function 'rcirc-fill-paragraph)
- (make-local-variable 'rcirc-recent-quit-alist)
- (setq rcirc-recent-quit-alist nil)
- (make-local-variable 'rcirc-current-line)
- (setq rcirc-current-line 0)
-
- (make-local-variable 'rcirc-short-buffer-name)
- (setq rcirc-short-buffer-name nil)
- (make-local-variable 'rcirc-urls)
- (setq use-hard-newlines t)
+ (set (make-local-variable 'rcirc-input-ring)
+ ;; If rcirc-input-ring is already a ring with desired size do
+ ;; not re-initialize.
+ (if (and (ring-p rcirc-input-ring)
+ (= (ring-size rcirc-input-ring)
+ rcirc-input-ring-size))
+ rcirc-input-ring
+ (make-ring rcirc-input-ring-size)))
+ (set (make-local-variable 'rcirc-server-buffer) (process-buffer process))
+ (set (make-local-variable 'rcirc-target) target)
+ (set (make-local-variable 'rcirc-topic) nil)
+ (set (make-local-variable 'rcirc-last-post-time) (current-time))
+ (set (make-local-variable 'fill-paragraph-function) 'rcirc-fill-paragraph)
+ (set (make-local-variable 'rcirc-recent-quit-alist) nil)
+ (set (make-local-variable 'rcirc-current-line) 0)
+
+ (use-hard-newlines t)
+ (set (make-local-variable 'rcirc-short-buffer-name) nil)
+ (set (make-local-variable 'rcirc-urls) nil)
;; setup for omitting responses
(setq buffer-invisibility-spec '())
(setq buffer-display-table (make-display-table))
(set-display-table-slot buffer-display-table 4
- (let ((glyph (make-glyph-code
+ (let ((glyph (make-glyph-code
?. 'font-lock-keyword-face)))
(make-vector 3 glyph)))
- (make-local-variable 'rcirc-decode-coding-system)
- (make-local-variable 'rcirc-encode-coding-system)
(dolist (i rcirc-coding-system-alist)
(let ((chan (if (consp (car i)) (caar i) (car i)))
(serv (if (consp (car i)) (cdar i) "")))
(when (and (string-match chan (or target ""))
(string-match serv (rcirc-server-name process)))
- (setq rcirc-decode-coding-system (if (consp (cdr i)) (cadr i) (cdr i))
- rcirc-encode-coding-system (if (consp (cdr i)) (cddr i) (cdr i))))))
+ (set (make-local-variable 'rcirc-decode-coding-system)
+ (if (consp (cdr i)) (cadr i) (cdr i)))
+ (set (make-local-variable 'rcirc-encode-coding-system)
+ (if (consp (cdr i)) (cddr i) (cdr i))))))
;; setup the prompt and markers
- (make-local-variable 'rcirc-prompt-start-marker)
- (setq rcirc-prompt-start-marker (make-marker))
- (set-marker rcirc-prompt-start-marker (point-max))
- (make-local-variable 'rcirc-prompt-end-marker)
- (setq rcirc-prompt-end-marker (make-marker))
- (set-marker rcirc-prompt-end-marker (point-max))
+ (set (make-local-variable 'rcirc-prompt-start-marker) (point-max-marker))
+ (set (make-local-variable 'rcirc-prompt-end-marker) (point-max-marker))
(rcirc-update-prompt)
(goto-char rcirc-prompt-end-marker)
- (make-local-variable 'overlay-arrow-position)
- (setq overlay-arrow-position (make-marker))
- (set-marker overlay-arrow-position nil)
+
+ (set (make-local-variable 'overlay-arrow-position) (make-marker))
;; if the user changes the major mode or kills the buffer, there is
;; cleanup work to do
(let ((buffer (current-buffer)))
(rcirc-clear-activity buffer)
(when (and (rcirc-buffer-process)
- (eq (process-status (rcirc-buffer-process)) 'open))
+ (rcirc--connection-open-p (rcirc-buffer-process)))
(with-rcirc-server-buffer
(setq rcirc-buffer-alist
(rassq-delete-all buffer rcirc-buffer-alist)))
(rcirc-generate-new-buffer-name process target))))
(with-current-buffer new-buffer
(rcirc-mode process target)
- (rcirc-put-nick-channel process (rcirc-nick process) target
+ (rcirc-put-nick-channel process (rcirc-nick process) target
rcirc-current-line))
new-buffer)))))
(concat command " :" args)))))))
(defvar rcirc-parent-buffer nil)
+(make-variable-buffer-local 'rcirc-parent-buffer)
+(put 'rcirc-parent-buffer 'permanent-local t)
(defvar rcirc-window-configuration nil)
(defun rcirc-edit-multiline ()
"Move current edit to a dedicated buffer."
(interactive)
(let ((pos (1+ (- (point) rcirc-prompt-end-marker))))
(goto-char (point-max))
- (let ((text (buffer-substring-no-properties rcirc-prompt-end-marker
+ (let ((text (buffer-substring-no-properties rcirc-prompt-end-marker
(point)))
(parent (buffer-name)))
(delete-region rcirc-prompt-end-marker (point))
: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 ()
(match-string 1 text)))
rcirc-ignore-list))
;; do not ignore if we sent the message
- (not (string= sender (rcirc-nick process))))
+ (not (string= sender (rcirc-nick process))))
(let* ((buffer (rcirc-target-buffer process sender response target text))
(inhibit-read-only t))
(with-current-buffer buffer
(old-point (point-marker))
(fill-start (marker-position rcirc-prompt-start-marker)))
+ (setq text (decode-coding-string text rcirc-decode-coding-system))
(unless (string= sender (rcirc-nick process))
- ;; only decode text from other senders, not ours
- (setq text (decode-coding-string text rcirc-decode-coding-system))
;; mark the line with overlay arrow
(unless (or (marker-position overlay-arrow-position)
(get-buffer-window (current-buffer))
;; keep window on bottom line if it was already there
(when rcirc-scroll-show-maximum-output
- (walk-windows (lambda (w)
- (when (eq (window-buffer w) (current-buffer))
- (with-current-buffer (window-buffer w)
- (when (eq major-mode 'rcirc-mode)
- (with-selected-window w
- (when (<= (- (window-height)
- (count-screen-lines (window-point)
- (window-start))
- 1)
- 0)
- (recenter -1)))))))
- nil t))
+ (let ((window (get-buffer-window)))
+ (when window
+ (with-selected-window window
+ (when (eq major-mode 'rcirc-mode)
+ (when (<= (- (window-height)
+ (count-screen-lines (window-point)
+ (window-start))
+ 1)
+ 0)
+ (recenter -1)))))))
;; flush undo (can we do something smarter here?)
(buffer-disable-undo)
(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
+ (find-file-other-window
+ (expand-file-name (funcall rcirc-log-filename-function
(rcirc-buffer-process) rcirc-target)
rcirc-log-directory)))
(defun rcirc-switch-to-server-buffer ()
"Switch to the server buffer associated with current channel buffer."
(interactive)
+ (unless (buffer-live-p rcirc-server-buffer)
+ (error "No such buffer"))
(switch-to-buffer rcirc-server-buffer))
(defun rcirc-jump-to-first-unread-line ()
(dolist (b buffers) ;; order the new channel buffers in the buffer list
(switch-to-buffer b)))))
+(defun-rcirc-command invite (nick-channel)
+ "Invite NICK to CHANNEL."
+ (interactive (list
+ (concat
+ (completing-read "Invite nick: "
+ (with-rcirc-server-buffer rcirc-nick-table))
+ " "
+ (read-string "Channel: "))))
+ (rcirc-send-string process (concat "INVITE " nick-channel)))
+
;; TODO: /part #channel reason, or consider removing #channel altogether
(defun-rcirc-command part (channel)
"Part CHANNEL."
(browse-url (completing-read "rcirc browse-url: "
completions nil nil initial-input 'history)
arg)))
-
-(defun rcirc-browse-url-at-point (point)
- "Send URL at point to `browse-url'."
- (interactive "d")
- (let ((beg (previous-single-property-change (1+ point) 'mouse-face))
- (end (next-single-property-change point 'mouse-face)))
- (browse-url (buffer-substring-no-properties beg end))))
-
-(defun rcirc-browse-url-at-mouse (event)
- "Send URL at mouse click to `browse-url'."
- (interactive "e")
- (let ((position (event-end event)))
- (with-current-buffer (window-buffer (posn-window position))
- (rcirc-browse-url-at-point (posn-point position)))))
-
\f
(defun rcirc-markup-timestamp (sender response)
(goto-char (point-min))
(rcirc-record-activity (current-buffer) 'nick)))))
(defun rcirc-markup-urls (sender response)
- (while (re-search-forward rcirc-url-regexp nil t)
+ (while (and rcirc-url-regexp ;; nil means disable URL catching
+ (re-search-forward rcirc-url-regexp nil t))
(let ((start (match-beginning 0))
- (end (match-end 0)))
- (rcirc-add-face start end 'rcirc-url)
- (add-text-properties start end (list 'mouse-face 'highlight
- 'keymap rcirc-browse-url-map))
+ (end (match-end 0))
+ (url (match-string-no-properties 0)))
+ (make-button start end
+ 'face 'rcirc-url
+ 'follow-link t
+ 'rcirc-url url
+ 'action (lambda (button)
+ (browse-url (button-get button 'rcirc-url))))
;; record the url
- (push (buffer-substring-no-properties start end) rcirc-urls))))
+ (push url rcirc-urls))))
(defun rcirc-markup-keywords (sender response)
(when (and (string= response "PRIVMSG")
rcirc-fill-column)
(t fill-column))
;; make sure ... doesn't cause line wrapping
- 3)))
+ 3)))
(fill-region (point) (point-max) nil t))))
\f
;;; handlers
(member message
(list
(format "You are now identified for \C-b%s\C-b." rcirc-nick)
+ (format "You are successfully identified as \C-b%s\C-b." rcirc-nick)
"Password accepted - you are now recognized."
)))
(and ;; quakenet
(setq rcirc-topic (caddr args)))))
(defun rcirc-handler-333 (process sender args text)
- "Not in rfc1459.txt"
+ "333 says who set the topic and when.
+Not in rfc1459.txt"
(let ((buffer (or (rcirc-get-buffer process (cadr args))
(rcirc-get-temp-buffer-create process (cadr args)))))
(with-current-buffer buffer
;; quakenet authentication doesn't rely on the user's nickname.
;; the variable `nick' here represents the Q account name.
(when (eq method 'quakenet)
- (rcirc-send-privmsg
+ (rcirc-send-privmsg
process
"Q@CServe.quakenet.org"
(format "AUTH %s %s" nick (car args))))))))))
HCoop / bpt / emacs.git / blobdiff