X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/a8346e4904ebdd046bda23b3e16983279fcb2438..8520d9c4e50520db79410ec6ef0052df129231dc:/lisp/net/rcirc.el?ds=sidebyside diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 148c9b7b29..f6981aeabd 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -55,7 +55,10 @@ :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). @@ -95,14 +98,22 @@ used. 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 @@ -304,7 +315,9 @@ Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT." :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) @@ -441,10 +454,11 @@ If ARG is non-nil, instead prompt for connection parameters." (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) @@ -456,7 +470,8 @@ If ARG is non-nil, instead prompt for connection parameters." (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)) @@ -465,7 +480,7 @@ If ARG is non-nil, instead prompt for connection parameters." (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 @@ -498,7 +513,7 @@ If ARG is non-nil, instead prompt for connection parameters." ;;;###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) @@ -511,7 +526,9 @@ If ARG is non-nil, instead prompt for connection parameters." (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)) @@ -519,32 +536,23 @@ If ARG is non-nil, instead prompt for connection parameters." (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) @@ -580,6 +588,17 @@ If ARG is non-nil, instead prompt for connection parameters." (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 @@ -602,7 +621,7 @@ last ping." (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) @@ -722,11 +741,14 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (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) @@ -793,18 +815,19 @@ If SILENT is non-nil, do not print the message in any irc buffer." (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)) @@ -878,12 +901,12 @@ IRC command completion is performed only if '/' is the first input char." (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))) @@ -913,14 +936,6 @@ IRC command completion is performed only if '/' is the first input char." 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 "") '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.") @@ -948,58 +963,51 @@ This number is independent of the number of lines in the buffer.") (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 @@ -1095,7 +1103,7 @@ Logfiles are kept in `rcirc-log-directory'." (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))) @@ -1143,7 +1151,7 @@ Create the buffer if it doesn't exist." (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))))) @@ -1222,13 +1230,15 @@ Create the buffer if it doesn't exist." (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)) @@ -1257,8 +1267,6 @@ Create the buffer if it doesn't exist." :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 () @@ -1469,7 +1477,7 @@ record activity." (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 @@ -1477,9 +1485,8 @@ record activity." (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)) @@ -1556,18 +1563,16 @@ record activity." ;; 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) @@ -1648,8 +1653,8 @@ log-files with absolute names (see `rcirc-log-filename-function')." (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))) @@ -1842,6 +1847,8 @@ Uninteresting lines are those whose responses are listed in (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 () @@ -2135,6 +2142,16 @@ CHANNELS is a comma- or space-separated string of channel names." (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." @@ -2342,21 +2359,6 @@ keywords when no KEYWORD is given." (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))))) - (defun rcirc-markup-timestamp (sender response) (goto-char (point-min)) @@ -2394,14 +2396,19 @@ keywords when no KEYWORD is given." (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") @@ -2436,7 +2443,7 @@ keywords when no KEYWORD is given." rcirc-fill-column) (t fill-column)) ;; make sure ... doesn't cause line wrapping - 3))) + 3))) (fill-region (point) (point-max) nil t)))) ;;; handlers @@ -2523,6 +2530,7 @@ the only argument." (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 @@ -2704,7 +2712,8 @@ the only argument." (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 @@ -2803,7 +2812,7 @@ Passwords are stored in `rcirc-authinfo' (which see)." ;; 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))))))))))