diff options
| author | Philip Kaludercic | 2022-09-06 17:07:12 +0200 |
|---|---|---|
| committer | Philip Kaludercic | 2022-09-07 11:18:32 +0200 |
| commit | 50020d026cda1fdd70d8a08e08185dbb7183646a (patch) | |
| tree | df2843c0554c67287b31444c6c3771d6985585bb | |
| parent | 25813b697cc910ba196ff03a911dbbc0f85c716a (diff) | |
| download | emacs-50020d026cda1fdd70d8a08e08185dbb7183646a.tar.gz emacs-50020d026cda1fdd70d8a08e08185dbb7183646a.zip | |
Untabify rcirc.el
| -rw-r--r-- | lisp/net/rcirc.el | 1318 |
1 files changed, 659 insertions, 659 deletions
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 71505dcaa39..fcef3f10104 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el | |||
| @@ -116,7 +116,7 @@ VALUE must be a string that will be used instead of the server | |||
| 116 | name for display purposes. If absent, the real server name will | 116 | name for display purposes. If absent, the real server name will |
| 117 | be displayed instead." | 117 | be displayed instead." |
| 118 | :type '(alist :key-type string | 118 | :type '(alist :key-type string |
| 119 | :value-type (plist :options | 119 | :value-type (plist :options |
| 120 | ((:nick string) | 120 | ((:nick string) |
| 121 | (:port integer) | 121 | (:port integer) |
| 122 | (:user-name string) | 122 | (:user-name string) |
| @@ -167,7 +167,7 @@ If a function (e.g., `frame-text-width' or `window-text-width'), | |||
| 167 | call it to compute the number of columns." | 167 | call it to compute the number of columns." |
| 168 | :risky t ; can get funcalled | 168 | :risky t ; can get funcalled |
| 169 | :type '(choice (const :tag "Value of `fill-column'" nil) | 169 | :type '(choice (const :tag "Value of `fill-column'" nil) |
| 170 | (integer :tag "Number of columns") | 170 | (integer :tag "Number of columns") |
| 171 | (function :tag "Function returning the number of columns"))) | 171 | (function :tag "Function returning the number of columns"))) |
| 172 | 172 | ||
| 173 | (defcustom rcirc-fill-prefix nil | 173 | (defcustom rcirc-fill-prefix nil |
| @@ -175,7 +175,7 @@ call it to compute the number of columns." | |||
| 175 | If nil, calculate the prefix dynamically to line up text | 175 | If nil, calculate the prefix dynamically to line up text |
| 176 | underneath each nick." | 176 | underneath each nick." |
| 177 | :type '(choice (const :tag "Dynamic" nil) | 177 | :type '(choice (const :tag "Dynamic" nil) |
| 178 | (string :tag "Prefix text"))) | 178 | (string :tag "Prefix text"))) |
| 179 | 179 | ||
| 180 | (defcustom rcirc-url-max-length nil | 180 | (defcustom rcirc-url-max-length nil |
| 181 | "Maximum number of characters in displayed URLs. | 181 | "Maximum number of characters in displayed URLs. |
| @@ -273,19 +273,19 @@ Examples: | |||
| 273 | (\"quakenet.org\" quakenet \"bobby\" \"sekrit\") | 273 | (\"quakenet.org\" quakenet \"bobby\" \"sekrit\") |
| 274 | (\"oftc\" sasl \"bob\" \"hunter2\"))" | 274 | (\"oftc\" sasl \"bob\" \"hunter2\"))" |
| 275 | :type '(alist :key-type (regexp :tag "Server") | 275 | :type '(alist :key-type (regexp :tag "Server") |
| 276 | :value-type (choice (list :tag "NickServ" | 276 | :value-type (choice (list :tag "NickServ" |
| 277 | (const nickserv) | 277 | (const nickserv) |
| 278 | (string :tag "Nick") | 278 | (string :tag "Nick") |
| 279 | (string :tag "Password")) | 279 | (string :tag "Password")) |
| 280 | (list :tag "ChanServ" | 280 | (list :tag "ChanServ" |
| 281 | (const chanserv) | 281 | (const chanserv) |
| 282 | (string :tag "Nick") | 282 | (string :tag "Nick") |
| 283 | (string :tag "Channel") | 283 | (string :tag "Channel") |
| 284 | (string :tag "Password")) | 284 | (string :tag "Password")) |
| 285 | (list :tag "BitlBee" | 285 | (list :tag "BitlBee" |
| 286 | (const bitlbee) | 286 | (const bitlbee) |
| 287 | (string :tag "Nick") | 287 | (string :tag "Nick") |
| 288 | (string :tag "Password")) | 288 | (string :tag "Password")) |
| 289 | (list :tag "QuakeNet" | 289 | (list :tag "QuakeNet" |
| 290 | (const quakenet) | 290 | (const quakenet) |
| 291 | (string :tag "Account") | 291 | (string :tag "Account") |
| @@ -388,10 +388,10 @@ messages. | |||
| 388 | If VAL is a cons of coding systems, the car part is used for decoding, | 388 | If VAL is a cons of coding systems, the car part is used for decoding, |
| 389 | and the cdr part is used for encoding." | 389 | and the cdr part is used for encoding." |
| 390 | :type '(alist :key-type (choice (regexp :tag "Channel Regexp") | 390 | :type '(alist :key-type (choice (regexp :tag "Channel Regexp") |
| 391 | (cons (regexp :tag "Channel Regexp") | 391 | (cons (regexp :tag "Channel Regexp") |
| 392 | (regexp :tag "Server Regexp"))) | 392 | (regexp :tag "Server Regexp"))) |
| 393 | :value-type (choice coding-system | 393 | :value-type (choice coding-system |
| 394 | (cons (coding-system :tag "Decode") | 394 | (cons (coding-system :tag "Decode") |
| 395 | (coding-system :tag "Encode"))))) | 395 | (coding-system :tag "Encode"))))) |
| 396 | 396 | ||
| 397 | (defcustom rcirc-multiline-major-mode 'fundamental-mode | 397 | (defcustom rcirc-multiline-major-mode 'fundamental-mode |
| @@ -520,50 +520,50 @@ If ARG is non-nil, instead prompt for connection parameters." | |||
| 520 | (interactive "P") | 520 | (interactive "P") |
| 521 | (if arg | 521 | (if arg |
| 522 | (let* ((server (completing-read "IRC Server: " | 522 | (let* ((server (completing-read "IRC Server: " |
| 523 | rcirc-server-alist | 523 | rcirc-server-alist |
| 524 | nil nil | 524 | nil nil |
| 525 | (caar rcirc-server-alist) | 525 | (caar rcirc-server-alist) |
| 526 | 'rcirc-server-name-history)) | 526 | 'rcirc-server-name-history)) |
| 527 | (server-plist (cdr (assoc-string server rcirc-server-alist))) | 527 | (server-plist (cdr (assoc-string server rcirc-server-alist))) |
| 528 | (port (read-string "IRC Port: " | 528 | (port (read-string "IRC Port: " |
| 529 | (number-to-string | 529 | (number-to-string |
| 530 | (or (plist-get server-plist :port) | 530 | (or (plist-get server-plist :port) |
| 531 | rcirc-default-port)) | 531 | rcirc-default-port)) |
| 532 | 'rcirc-server-port-history)) | 532 | 'rcirc-server-port-history)) |
| 533 | (nick (read-string "IRC Nick: " | 533 | (nick (read-string "IRC Nick: " |
| 534 | (or (plist-get server-plist :nick) | 534 | (or (plist-get server-plist :nick) |
| 535 | rcirc-default-nick) | 535 | rcirc-default-nick) |
| 536 | 'rcirc-nick-name-history)) | 536 | 'rcirc-nick-name-history)) |
| 537 | (user-name (read-string "IRC Username: " | 537 | (user-name (read-string "IRC Username: " |
| 538 | (or (plist-get server-plist :user-name) | 538 | (or (plist-get server-plist :user-name) |
| 539 | rcirc-default-user-name) | 539 | rcirc-default-user-name) |
| 540 | 'rcirc-user-name-history)) | 540 | 'rcirc-user-name-history)) |
| 541 | (password (read-passwd "IRC Password: " nil | 541 | (password (read-passwd "IRC Password: " nil |
| 542 | (plist-get server-plist :password))) | 542 | (plist-get server-plist :password))) |
| 543 | (channels (split-string | 543 | (channels (split-string |
| 544 | (read-string "IRC Channels: " | 544 | (read-string "IRC Channels: " |
| 545 | (mapconcat 'identity | 545 | (mapconcat 'identity |
| 546 | (plist-get server-plist | 546 | (plist-get server-plist |
| 547 | :channels) | 547 | :channels) |
| 548 | " ")) | 548 | " ")) |
| 549 | "[, ]+" t)) | 549 | "[, ]+" t)) |
| 550 | (encryption (rcirc-prompt-for-encryption server-plist)) | 550 | (encryption (rcirc-prompt-for-encryption server-plist)) |
| 551 | (process (rcirc-connect server port nick user-name | 551 | (process (rcirc-connect server port nick user-name |
| 552 | rcirc-default-full-name | 552 | rcirc-default-full-name |
| 553 | channels password encryption))) | 553 | channels password encryption))) |
| 554 | (when rcirc-display-server-buffer | 554 | (when rcirc-display-server-buffer |
| 555 | (pop-to-buffer-same-window (process-buffer process)))) | 555 | (pop-to-buffer-same-window (process-buffer process)))) |
| 556 | ;; connect to servers in `rcirc-server-alist' | 556 | ;; connect to servers in `rcirc-server-alist' |
| 557 | (let (connected-servers) | 557 | (let (connected-servers) |
| 558 | (dolist (c rcirc-server-alist) | 558 | (dolist (c rcirc-server-alist) |
| 559 | (let ((server (car c)) | 559 | (let ((server (car c)) |
| 560 | (nick (or (plist-get (cdr c) :nick) rcirc-default-nick)) | 560 | (nick (or (plist-get (cdr c) :nick) rcirc-default-nick)) |
| 561 | (port (or (plist-get (cdr c) :port) rcirc-default-port)) | 561 | (port (or (plist-get (cdr c) :port) rcirc-default-port)) |
| 562 | (user-name (or (plist-get (cdr c) :user-name) | 562 | (user-name (or (plist-get (cdr c) :user-name) |
| 563 | rcirc-default-user-name)) | 563 | rcirc-default-user-name)) |
| 564 | (full-name (or (plist-get (cdr c) :full-name) | 564 | (full-name (or (plist-get (cdr c) :full-name) |
| 565 | rcirc-default-full-name)) | 565 | rcirc-default-full-name)) |
| 566 | (channels (plist-get (cdr c) :channels)) | 566 | (channels (plist-get (cdr c) :channels)) |
| 567 | (password (plist-get (cdr c) :password)) | 567 | (password (plist-get (cdr c) :password)) |
| 568 | (encryption (plist-get (cdr c) :encryption)) | 568 | (encryption (plist-get (cdr c) :encryption)) |
| 569 | (server-alias (plist-get (cdr c) :server-alias)) | 569 | (server-alias (plist-get (cdr c) :server-alias)) |
| @@ -577,21 +577,21 @@ If ARG is non-nil, instead prompt for connection parameters." | |||
| 577 | :port port)) | 577 | :port port)) |
| 578 | (pwd (auth-info-password (car auth)))) | 578 | (pwd (auth-info-password (car auth)))) |
| 579 | (setq password pwd)) | 579 | (setq password pwd)) |
| 580 | (when server | 580 | (when server |
| 581 | (let (connected) | 581 | (let (connected) |
| 582 | (dolist (p (rcirc-process-list)) | 582 | (dolist (p (rcirc-process-list)) |
| 583 | (when (string= (or server-alias server) (process-name p)) | 583 | (when (string= (or server-alias server) (process-name p)) |
| 584 | (setq connected p))) | 584 | (setq connected p))) |
| 585 | (if (not connected) | 585 | (if (not connected) |
| 586 | (condition-case nil | 586 | (condition-case nil |
| 587 | (let ((process (rcirc-connect server port nick user-name | 587 | (let ((process (rcirc-connect server port nick user-name |
| 588 | full-name channels password encryption | 588 | full-name channels password encryption |
| 589 | client-cert server-alias))) | 589 | client-cert server-alias))) |
| 590 | (when rcirc-display-server-buffer | 590 | (when rcirc-display-server-buffer |
| 591 | (pop-to-buffer-same-window (process-buffer process)))) | 591 | (pop-to-buffer-same-window (process-buffer process)))) |
| 592 | (quit (message "Quit connecting to %s" | 592 | (quit (message "Quit connecting to %s" |
| 593 | (or server-alias server)))) | 593 | (or server-alias server)))) |
| 594 | (with-current-buffer (process-buffer connected) | 594 | (with-current-buffer (process-buffer connected) |
| 595 | (setq contact (process-contact | 595 | (setq contact (process-contact |
| 596 | (get-buffer-process (current-buffer)) :name)) | 596 | (get-buffer-process (current-buffer)) :name)) |
| 597 | (setq connected-servers | 597 | (setq connected-servers |
| @@ -599,12 +599,12 @@ If ARG is non-nil, instead prompt for connection parameters." | |||
| 599 | contact (or server-alias server)) | 599 | contact (or server-alias server)) |
| 600 | connected-servers)))))))) | 600 | connected-servers)))))))) |
| 601 | (when connected-servers | 601 | (when connected-servers |
| 602 | (message "Already connected to %s" | 602 | (message "Already connected to %s" |
| 603 | (if (cdr connected-servers) | 603 | (if (cdr connected-servers) |
| 604 | (concat (mapconcat 'identity (butlast connected-servers) ", ") | 604 | (concat (mapconcat 'identity (butlast connected-servers) ", ") |
| 605 | ", and " | 605 | ", and " |
| 606 | (car (last connected-servers))) | 606 | (car (last connected-servers))) |
| 607 | (car connected-servers))))))) | 607 | (car connected-servers))))))) |
| 608 | 608 | ||
| 609 | ;;;###autoload | 609 | ;;;###autoload |
| 610 | (defalias 'irc 'rcirc) | 610 | (defalias 'irc 'rcirc) |
| @@ -732,7 +732,7 @@ that are joined after authentication." | |||
| 732 | (setq rcirc-nick nick) | 732 | (setq rcirc-nick nick) |
| 733 | (setq rcirc-startup-channels startup-channels) | 733 | (setq rcirc-startup-channels startup-channels) |
| 734 | (setq rcirc-last-connect-time (current-time)) | 734 | (setq rcirc-last-connect-time (current-time)) |
| 735 | (setq rcirc-last-server-message-time rcirc-last-connect-time) | 735 | (setq rcirc-last-server-message-time rcirc-last-connect-time) |
| 736 | 736 | ||
| 737 | ;; Check if the immediate process state | 737 | ;; Check if the immediate process state |
| 738 | (sit-for .1) | 738 | (sit-for .1) |
| @@ -804,8 +804,8 @@ MESSAGE should contain a timestamp, indicating when the KEEPALIVE | |||
| 804 | message was generated." | 804 | message was generated." |
| 805 | (with-rcirc-process-buffer process | 805 | (with-rcirc-process-buffer process |
| 806 | (setq header-line-format | 806 | (setq header-line-format |
| 807 | (format "%f" (float-time | 807 | (format "%f" (float-time |
| 808 | (time-since (string-to-number message))))))) | 808 | (time-since (string-to-number message))))))) |
| 809 | 809 | ||
| 810 | (defvar rcirc-debug-buffer "*rcirc debug*" | 810 | (defvar rcirc-debug-buffer "*rcirc debug*" |
| 811 | "Buffer name for debugging messages.") | 811 | "Buffer name for debugging messages.") |
| @@ -864,19 +864,19 @@ If QUIET is non-nil, no not emit a message." | |||
| 864 | (throw 'exit (or quiet (message "Server process is alive"))) | 864 | (throw 'exit (or quiet (message "Server process is alive"))) |
| 865 | (delete-process process)) | 865 | (delete-process process)) |
| 866 | (let ((conn-info rcirc-connection-info)) | 866 | (let ((conn-info rcirc-connection-info)) |
| 867 | (setf (nth 5 conn-info) | 867 | (setf (nth 5 conn-info) |
| 868 | (cl-remove-if-not #'rcirc-channel-p | 868 | (cl-remove-if-not #'rcirc-channel-p |
| 869 | (mapcar #'car rcirc-buffer-alist))) | 869 | (mapcar #'car rcirc-buffer-alist))) |
| 870 | (dolist (buffer (mapcar #'cdr rcirc-buffer-alist)) | 870 | (dolist (buffer (mapcar #'cdr rcirc-buffer-alist)) |
| 871 | (when (buffer-live-p buffer) | 871 | (when (buffer-live-p buffer) |
| 872 | (with-current-buffer buffer | 872 | (with-current-buffer buffer |
| 873 | (setq mode-line-process ":connecting")))) | 873 | (setq mode-line-process ":connecting")))) |
| 874 | (let ((nprocess (apply #'rcirc-connect conn-info))) | 874 | (let ((nprocess (apply #'rcirc-connect conn-info))) |
| 875 | (when (and (< rcirc-failed-attempts rcirc-reconnect-attempts) | 875 | (when (and (< rcirc-failed-attempts rcirc-reconnect-attempts) |
| 876 | (eq (process-status nprocess) 'failed)) | 876 | (eq (process-status nprocess) 'failed)) |
| 877 | (setq rcirc-failed-attempts (1+ rcirc-failed-attempts)) | 877 | (setq rcirc-failed-attempts (1+ rcirc-failed-attempts)) |
| 878 | (rcirc-print nprocess "*rcirc*" "ERROR" nil | 878 | (rcirc-print nprocess "*rcirc*" "ERROR" nil |
| 879 | (format "Failed to reconnect (%d/%d)..." | 879 | (format "Failed to reconnect (%d/%d)..." |
| 880 | rcirc-failed-attempts | 880 | rcirc-failed-attempts |
| 881 | rcirc-reconnect-attempts)) | 881 | rcirc-reconnect-attempts)) |
| 882 | (setq rcirc-reconnection-timer | 882 | (setq rcirc-reconnection-timer |
| @@ -932,26 +932,26 @@ SENTINEL describes the change in form of a string." | |||
| 932 | 932 | ||
| 933 | (message "Connecting to %s...done" (or server-alias server)) | 933 | (message "Connecting to %s...done" (or server-alias server)) |
| 934 | (dolist (buffer (cons nil (mapcar 'cdr rcirc-buffer-alist))) | 934 | (dolist (buffer (cons nil (mapcar 'cdr rcirc-buffer-alist))) |
| 935 | (with-current-buffer (or buffer (current-buffer)) | 935 | (with-current-buffer (or buffer (current-buffer)) |
| 936 | (setq mode-line-process nil))))) | 936 | (setq mode-line-process nil))))) |
| 937 | ((eq status 'closed) | 937 | ((eq status 'closed) |
| 938 | (let ((now (current-time))) | 938 | (let ((now (current-time))) |
| 939 | (with-rcirc-process-buffer process | 939 | (with-rcirc-process-buffer process |
| 940 | (when (and (< 0 rcirc-reconnect-delay) | 940 | (when (and (< 0 rcirc-reconnect-delay) |
| 941 | (time-less-p rcirc-reconnect-delay | 941 | (time-less-p rcirc-reconnect-delay |
| 942 | (time-subtract now rcirc-last-connect-time))) | 942 | (time-subtract now rcirc-last-connect-time))) |
| 943 | (setq rcirc-last-connect-time now) | 943 | (setq rcirc-last-connect-time now) |
| 944 | (rcirc-reconnect process))))) | 944 | (rcirc-reconnect process))))) |
| 945 | ((eq status 'failed) | 945 | ((eq status 'failed) |
| 946 | (dolist (buffer (cons nil (mapcar 'cdr rcirc-buffer-alist))) | 946 | (dolist (buffer (cons nil (mapcar 'cdr rcirc-buffer-alist))) |
| 947 | (with-current-buffer (or buffer (current-buffer)) | 947 | (with-current-buffer (or buffer (current-buffer)) |
| 948 | (rcirc-print process "*rcirc*" "ERROR" rcirc-target | 948 | (rcirc-print process "*rcirc*" "ERROR" rcirc-target |
| 949 | (format "%s: %s (%S)" | 949 | (format "%s: %s (%S)" |
| 950 | (process-name process) | 950 | (process-name process) |
| 951 | sentinel | 951 | sentinel |
| 952 | (process-status process)) | 952 | (process-status process)) |
| 953 | (not rcirc-target)) | 953 | (not rcirc-target)) |
| 954 | (rcirc-disconnect-buffer))))) | 954 | (rcirc-disconnect-buffer))))) |
| 955 | (run-hook-with-args 'rcirc-sentinel-functions process sentinel)))) | 955 | (run-hook-with-args 'rcirc-sentinel-functions process sentinel)))) |
| 956 | 956 | ||
| 957 | (defun rcirc-disconnect-buffer (&optional buffer) | 957 | (defun rcirc-disconnect-buffer (&optional buffer) |
| @@ -998,10 +998,10 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") | |||
| 998 | (with-rcirc-process-buffer process | 998 | (with-rcirc-process-buffer process |
| 999 | (when (not rcirc-connecting) | 999 | (when (not rcirc-connecting) |
| 1000 | (with-rcirc-process-buffer process | 1000 | (with-rcirc-process-buffer process |
| 1001 | (when rcirc-timeout-timer (cancel-timer rcirc-timeout-timer)) | 1001 | (when rcirc-timeout-timer (cancel-timer rcirc-timeout-timer)) |
| 1002 | (setq rcirc-timeout-timer (run-at-time rcirc-timeout-seconds nil | 1002 | (setq rcirc-timeout-timer (run-at-time rcirc-timeout-seconds nil |
| 1003 | 'delete-process | 1003 | 'delete-process |
| 1004 | process)))))) | 1004 | process)))))) |
| 1005 | 1005 | ||
| 1006 | (defvar rcirc-trap-errors-flag t | 1006 | (defvar rcirc-trap-errors-flag t |
| 1007 | "Non-nil means Lisp errors are degraded to error messages.") | 1007 | "Non-nil means Lisp errors are degraded to error messages.") |
| @@ -1017,7 +1017,7 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") | |||
| 1017 | 1017 | ||
| 1018 | (defconst rcirc-process-regexp | 1018 | (defconst rcirc-process-regexp |
| 1019 | (rx-let ((message-tag ; message tags as specified in | 1019 | (rx-let ((message-tag ; message tags as specified in |
| 1020 | ; https://ircv3.net/specs/extensions/message-tags | 1020 | ; https://ircv3.net/specs/extensions/message-tags |
| 1021 | (: (? "+") | 1021 | (: (? "+") |
| 1022 | (? (+ (or alnum "-")) (+ "." (+ (or alnum "-"))) "/") | 1022 | (? (+ (or alnum "-")) (+ "." (+ (or alnum "-"))) "/") |
| 1023 | (+ (any alnum "-")) | 1023 | (+ (any alnum "-")) |
| @@ -1098,7 +1098,7 @@ Note that the messages are stored in reverse order.") | |||
| 1098 | (split-string tag-data ";")))) | 1098 | (split-string tag-data ";")))) |
| 1099 | rcirc-message-tags)) | 1099 | rcirc-message-tags)) |
| 1100 | (user (match-string 3 text)) | 1100 | (user (match-string 3 text)) |
| 1101 | (sender (rcirc-user-nick user)) | 1101 | (sender (rcirc-user-nick user)) |
| 1102 | (cmd (match-string 4 text)) | 1102 | (cmd (match-string 4 text)) |
| 1103 | (cmd-end (match-end 4)) | 1103 | (cmd-end (match-end 4)) |
| 1104 | (args nil) | 1104 | (args nil) |
| @@ -1140,7 +1140,7 @@ found. PROCESS, SENDER and RESPONSE are passed on to | |||
| 1140 | used as the message body." | 1140 | used as the message body." |
| 1141 | (rcirc-print process sender response nil | 1141 | (rcirc-print process sender response nil |
| 1142 | (mapconcat 'identity (cdr args) " ") | 1142 | (mapconcat 'identity (cdr args) " ") |
| 1143 | (not (member response rcirc-responses-no-activity)))) | 1143 | (not (member response rcirc-responses-no-activity)))) |
| 1144 | 1144 | ||
| 1145 | (defun rcirc--connection-open-p (process) | 1145 | (defun rcirc--connection-open-p (process) |
| 1146 | "Check if PROCESS is open or running." | 1146 | "Check if PROCESS is open or running." |
| @@ -1186,7 +1186,7 @@ element in PARTS is a list, append it to PARTS." | |||
| 1186 | "Return the process associated with channel BUFFER. | 1186 | "Return the process associated with channel BUFFER. |
| 1187 | With no argument or nil as argument, use the current buffer." | 1187 | With no argument or nil as argument, use the current buffer." |
| 1188 | (let ((buffer (or buffer (and (buffer-live-p rcirc-server-buffer) | 1188 | (let ((buffer (or buffer (and (buffer-live-p rcirc-server-buffer) |
| 1189 | rcirc-server-buffer)))) | 1189 | rcirc-server-buffer)))) |
| 1190 | (if buffer | 1190 | (if buffer |
| 1191 | (buffer-local-value 'rcirc-process buffer) | 1191 | (buffer-local-value 'rcirc-process buffer) |
| 1192 | rcirc-process))) | 1192 | rcirc-process))) |
| @@ -1195,7 +1195,7 @@ With no argument or nil as argument, use the current buffer." | |||
| 1195 | "Return PROCESS server name, given by the 001 response." | 1195 | "Return PROCESS server name, given by the 001 response." |
| 1196 | (with-rcirc-process-buffer process | 1196 | (with-rcirc-process-buffer process |
| 1197 | (or rcirc-server-name | 1197 | (or rcirc-server-name |
| 1198 | (warn "server name for process %S unknown" process)))) | 1198 | (warn "server name for process %S unknown" process)))) |
| 1199 | 1199 | ||
| 1200 | (defun rcirc-nick (process) | 1200 | (defun rcirc-nick (process) |
| 1201 | "Return PROCESS nick." | 1201 | "Return PROCESS nick." |
| @@ -1220,17 +1220,17 @@ With no argument or nil as argument, use the current buffer." | |||
| 1220 | (insert message) | 1220 | (insert message) |
| 1221 | (goto-char (point-min)) | 1221 | (goto-char (point-min)) |
| 1222 | (let (result) | 1222 | (let (result) |
| 1223 | (while (not (eobp)) | 1223 | (while (not (eobp)) |
| 1224 | (goto-char (or (byte-to-position rcirc-max-message-length) | 1224 | (goto-char (or (byte-to-position rcirc-max-message-length) |
| 1225 | (point-max))) | 1225 | (point-max))) |
| 1226 | ;; max message length is 512 including CRLF | 1226 | ;; max message length is 512 including CRLF |
| 1227 | (while (and (not (bobp)) | 1227 | (while (and (not (bobp)) |
| 1228 | (> (length (encode-coding-region | 1228 | (> (length (encode-coding-region |
| 1229 | (point-min) (point) encoding t)) | 1229 | (point-min) (point) encoding t)) |
| 1230 | rcirc-max-message-length)) | 1230 | rcirc-max-message-length)) |
| 1231 | (forward-char -1)) | 1231 | (forward-char -1)) |
| 1232 | (push (delete-and-extract-region (point-min) (point)) result)) | 1232 | (push (delete-and-extract-region (point-min) (point)) result)) |
| 1233 | (nreverse result))))) | 1233 | (nreverse result))))) |
| 1234 | 1234 | ||
| 1235 | (defun rcirc-send-message (process target message &optional noticep silent) | 1235 | (defun rcirc-send-message (process target message &optional noticep silent) |
| 1236 | "Send TARGET associated with PROCESS a privmsg with text MESSAGE. | 1236 | "Send TARGET associated with PROCESS a privmsg with text MESSAGE. |
| @@ -1241,7 +1241,7 @@ If SILENT is non-nil, do not print the message in any irc buffer." | |||
| 1241 | (dolist (msg (rcirc-split-message message)) | 1241 | (dolist (msg (rcirc-split-message message)) |
| 1242 | (rcirc-send-string process response target : msg) | 1242 | (rcirc-send-string process response target : msg) |
| 1243 | (unless silent | 1243 | (unless silent |
| 1244 | (rcirc-print process (rcirc-nick process) response target msg))))) | 1244 | (rcirc-print process (rcirc-nick process) response target msg))))) |
| 1245 | 1245 | ||
| 1246 | (defvar-local rcirc-input-ring nil | 1246 | (defvar-local rcirc-input-ring nil |
| 1247 | "Ring object for input.") | 1247 | "Ring object for input.") |
| @@ -1293,10 +1293,10 @@ The list is updated automatically by `defun-rcirc-command'.") | |||
| 1293 | ;; On some networks it is common to message or | 1293 | ;; On some networks it is common to message or |
| 1294 | ;; mention someone using @nick instead of just | 1294 | ;; mention someone using @nick instead of just |
| 1295 | ;; nick. | 1295 | ;; nick. |
| 1296 | (if (re-search-backward "[[:space:]@]" rcirc-prompt-end-marker t) | 1296 | (if (re-search-backward "[[:space:]@]" rcirc-prompt-end-marker t) |
| 1297 | (1+ (point)) | 1297 | (1+ (point)) |
| 1298 | rcirc-prompt-end-marker))) | 1298 | rcirc-prompt-end-marker))) |
| 1299 | (table (cond | 1299 | (table (cond |
| 1300 | ;; No completion before the prompt | 1300 | ;; No completion before the prompt |
| 1301 | ((< beg rcirc-prompt-end-marker) nil) | 1301 | ((< beg rcirc-prompt-end-marker) nil) |
| 1302 | ;; Only complete nicks mid-message | 1302 | ;; Only complete nicks mid-message |
| @@ -1304,23 +1304,23 @@ The list is updated automatically by `defun-rcirc-command'.") | |||
| 1304 | (mapcar rcirc-nick-filter | 1304 | (mapcar rcirc-nick-filter |
| 1305 | (rcirc-channel-nicks | 1305 | (rcirc-channel-nicks |
| 1306 | (rcirc-buffer-process) | 1306 | (rcirc-buffer-process) |
| 1307 | rcirc-target))) | 1307 | rcirc-target))) |
| 1308 | ;; Complete commands at the beginning of the | 1308 | ;; Complete commands at the beginning of the |
| 1309 | ;; message, when the first character is a dash | 1309 | ;; message, when the first character is a dash |
| 1310 | ((eq (char-after beg) ?/) | 1310 | ((eq (char-after beg) ?/) |
| 1311 | (mapcar | 1311 | (mapcar |
| 1312 | (lambda (cmd) (concat cmd " ")) | 1312 | (lambda (cmd) (concat cmd " ")) |
| 1313 | (nconc (sort (copy-sequence rcirc-client-commands) | 1313 | (nconc (sort (copy-sequence rcirc-client-commands) |
| 1314 | 'string-lessp) | 1314 | 'string-lessp) |
| 1315 | (sort (copy-sequence rcirc-server-commands) | 1315 | (sort (copy-sequence rcirc-server-commands) |
| 1316 | 'string-lessp)))) | 1316 | 'string-lessp)))) |
| 1317 | ;; Complete usernames right after the prompt by | 1317 | ;; Complete usernames right after the prompt by |
| 1318 | ;; appending a colon after the name | 1318 | ;; appending a colon after the name |
| 1319 | ((mapcar | 1319 | ((mapcar |
| 1320 | (lambda (str) (concat (funcall rcirc-nick-filter str) ": ")) | 1320 | (lambda (str) (concat (funcall rcirc-nick-filter str) ": ")) |
| 1321 | (rcirc-channel-nicks (rcirc-buffer-process) | 1321 | (rcirc-channel-nicks (rcirc-buffer-process) |
| 1322 | rcirc-target)))))) | 1322 | rcirc-target)))))) |
| 1323 | (list beg (point) | 1323 | (list beg (point) |
| 1324 | (lambda (str pred action) | 1324 | (lambda (str pred action) |
| 1325 | (if (eq action 'metadata) | 1325 | (if (eq action 'metadata) |
| 1326 | '(metadata (cycle-sort-function . identity)) | 1326 | '(metadata (cycle-sort-function . identity)) |
| @@ -1416,13 +1416,13 @@ PROCESS is the process object used for communication. | |||
| 1416 | (setq mode-line-process nil) | 1416 | (setq mode-line-process nil) |
| 1417 | 1417 | ||
| 1418 | (setq rcirc-input-ring | 1418 | (setq rcirc-input-ring |
| 1419 | ;; If rcirc-input-ring is already a ring with desired | 1419 | ;; If rcirc-input-ring is already a ring with desired |
| 1420 | ;; size do not re-initialize. | 1420 | ;; size do not re-initialize. |
| 1421 | (if (and (ring-p rcirc-input-ring) | 1421 | (if (and (ring-p rcirc-input-ring) |
| 1422 | (= (ring-size rcirc-input-ring) | 1422 | (= (ring-size rcirc-input-ring) |
| 1423 | rcirc-input-ring-size)) | 1423 | rcirc-input-ring-size)) |
| 1424 | rcirc-input-ring | 1424 | rcirc-input-ring |
| 1425 | (make-ring rcirc-input-ring-size))) | 1425 | (make-ring rcirc-input-ring-size))) |
| 1426 | (setq rcirc-server-buffer (process-buffer process)) | 1426 | (setq rcirc-server-buffer (process-buffer process)) |
| 1427 | (setq rcirc-target target) | 1427 | (setq rcirc-target target) |
| 1428 | (setq rcirc-last-post-time (current-time)) | 1428 | (setq rcirc-last-post-time (current-time)) |
| @@ -1435,19 +1435,19 @@ PROCESS is the process object used for communication. | |||
| 1435 | (setq buffer-invisibility-spec '()) | 1435 | (setq buffer-invisibility-spec '()) |
| 1436 | (setq buffer-display-table (make-display-table)) | 1436 | (setq buffer-display-table (make-display-table)) |
| 1437 | (set-display-table-slot buffer-display-table 4 | 1437 | (set-display-table-slot buffer-display-table 4 |
| 1438 | (let ((glyph (make-glyph-code | 1438 | (let ((glyph (make-glyph-code |
| 1439 | ?. 'font-lock-keyword-face))) | 1439 | ?. 'font-lock-keyword-face))) |
| 1440 | (make-vector 3 glyph))) | 1440 | (make-vector 3 glyph))) |
| 1441 | 1441 | ||
| 1442 | (dolist (i rcirc-coding-system-alist) | 1442 | (dolist (i rcirc-coding-system-alist) |
| 1443 | (let ((chan (if (consp (car i)) (caar i) (car i))) | 1443 | (let ((chan (if (consp (car i)) (caar i) (car i))) |
| 1444 | (serv (if (consp (car i)) (cdar i) ""))) | 1444 | (serv (if (consp (car i)) (cdar i) ""))) |
| 1445 | (when (and (string-match chan (or target "")) | 1445 | (when (and (string-match chan (or target "")) |
| 1446 | (string-match serv (rcirc-server-name process))) | 1446 | (string-match serv (rcirc-server-name process))) |
| 1447 | (setq-local rcirc-decode-coding-system | 1447 | (setq-local rcirc-decode-coding-system |
| 1448 | (if (consp (cdr i)) (cadr i) (cdr i))) | 1448 | (if (consp (cdr i)) (cadr i) (cdr i))) |
| 1449 | (setq-local rcirc-encode-coding-system | 1449 | (setq-local rcirc-encode-coding-system |
| 1450 | (if (consp (cdr i)) (cddr i) (cdr i)))))) | 1450 | (if (consp (cdr i)) (cddr i) (cdr i)))))) |
| 1451 | 1451 | ||
| 1452 | ;; setup the prompt and markers | 1452 | ;; setup the prompt and markers |
| 1453 | (setq rcirc-prompt-start-marker (point-max-marker)) | 1453 | (setq rcirc-prompt-start-marker (point-max-marker)) |
| @@ -1463,7 +1463,7 @@ PROCESS is the process object used for communication. | |||
| 1463 | (add-hook 'kill-buffer-hook 'rcirc-kill-buffer-hook nil t) | 1463 | (add-hook 'kill-buffer-hook 'rcirc-kill-buffer-hook nil t) |
| 1464 | 1464 | ||
| 1465 | ;; add to buffer list, and update buffer abbrevs | 1465 | ;; add to buffer list, and update buffer abbrevs |
| 1466 | (when target ; skip server buffer | 1466 | (when target ; skip server buffer |
| 1467 | (let ((buffer (current-buffer))) | 1467 | (let ((buffer (current-buffer))) |
| 1468 | (with-rcirc-process-buffer process | 1468 | (with-rcirc-process-buffer process |
| 1469 | (push (cons target buffer) rcirc-buffer-alist))) | 1469 | (push (cons target buffer) rcirc-buffer-alist))) |
| @@ -1485,41 +1485,41 @@ PROCESS is the process object used for communication. | |||
| 1485 | If ALL is non-nil, update prompts in all IRC buffers." | 1485 | If ALL is non-nil, update prompts in all IRC buffers." |
| 1486 | (if all | 1486 | (if all |
| 1487 | (mapc (lambda (process) | 1487 | (mapc (lambda (process) |
| 1488 | (mapc (lambda (buffer) | 1488 | (mapc (lambda (buffer) |
| 1489 | (with-current-buffer buffer | 1489 | (with-current-buffer buffer |
| 1490 | (rcirc-update-prompt))) | 1490 | (rcirc-update-prompt))) |
| 1491 | (with-rcirc-process-buffer process | 1491 | (with-rcirc-process-buffer process |
| 1492 | (mapcar 'cdr rcirc-buffer-alist)))) | 1492 | (mapcar 'cdr rcirc-buffer-alist)))) |
| 1493 | (rcirc-process-list)) | 1493 | (rcirc-process-list)) |
| 1494 | (let ((inhibit-read-only t) | 1494 | (let ((inhibit-read-only t) |
| 1495 | (prompt (or rcirc-prompt ""))) | 1495 | (prompt (or rcirc-prompt ""))) |
| 1496 | (mapc (lambda (rep) | 1496 | (mapc (lambda (rep) |
| 1497 | (setq prompt | 1497 | (setq prompt |
| 1498 | (replace-regexp-in-string (car rep) (cdr rep) prompt))) | 1498 | (replace-regexp-in-string (car rep) (cdr rep) prompt))) |
| 1499 | (list (cons "%n" (rcirc-buffer-nick)) | 1499 | (list (cons "%n" (rcirc-buffer-nick)) |
| 1500 | (cons "%s" (with-rcirc-server-buffer rcirc-server-name)) | 1500 | (cons "%s" (with-rcirc-server-buffer rcirc-server-name)) |
| 1501 | (cons "%t" (or rcirc-target "")))) | 1501 | (cons "%t" (or rcirc-target "")))) |
| 1502 | (save-excursion | 1502 | (save-excursion |
| 1503 | (delete-region rcirc-prompt-start-marker rcirc-prompt-end-marker) | 1503 | (delete-region rcirc-prompt-start-marker rcirc-prompt-end-marker) |
| 1504 | (goto-char rcirc-prompt-start-marker) | 1504 | (goto-char rcirc-prompt-start-marker) |
| 1505 | (let ((start (point))) | 1505 | (let ((start (point))) |
| 1506 | (insert-before-markers prompt) | 1506 | (insert-before-markers prompt) |
| 1507 | (set-marker rcirc-prompt-start-marker start) | 1507 | (set-marker rcirc-prompt-start-marker start) |
| 1508 | (when (not (zerop (- rcirc-prompt-end-marker | 1508 | (when (not (zerop (- rcirc-prompt-end-marker |
| 1509 | rcirc-prompt-start-marker))) | 1509 | rcirc-prompt-start-marker))) |
| 1510 | (add-text-properties rcirc-prompt-start-marker | 1510 | (add-text-properties rcirc-prompt-start-marker |
| 1511 | rcirc-prompt-end-marker | 1511 | rcirc-prompt-end-marker |
| 1512 | (list 'face 'rcirc-prompt | 1512 | (list 'face 'rcirc-prompt |
| 1513 | 'read-only t 'field t | 1513 | 'read-only t 'field t |
| 1514 | 'front-sticky t 'rear-nonsticky t)))))))) | 1514 | 'front-sticky t 'rear-nonsticky t)))))))) |
| 1515 | 1515 | ||
| 1516 | (defun rcirc-set-changed (option value) | 1516 | (defun rcirc-set-changed (option value) |
| 1517 | "Set OPTION to VALUE and update after a customization change." | 1517 | "Set OPTION to VALUE and update after a customization change." |
| 1518 | (set-default option value) | 1518 | (set-default option value) |
| 1519 | (cond ((eq option 'rcirc-prompt) | 1519 | (cond ((eq option 'rcirc-prompt) |
| 1520 | (rcirc-update-prompt 'all)) | 1520 | (rcirc-update-prompt 'all)) |
| 1521 | (t | 1521 | (t |
| 1522 | (error "Bad option %s" option)))) | 1522 | (error "Bad option %s" option)))) |
| 1523 | 1523 | ||
| 1524 | (defun rcirc-channel-p (target) | 1524 | (defun rcirc-channel-p (target) |
| 1525 | "Return t if TARGET is a channel name." | 1525 | "Return t if TARGET is a channel name." |
| @@ -1554,7 +1554,7 @@ with it." | |||
| 1554 | (when (and rcirc-buffer-alist ;; it's a server buffer | 1554 | (when (and rcirc-buffer-alist ;; it's a server buffer |
| 1555 | rcirc-kill-channel-buffers) | 1555 | rcirc-kill-channel-buffers) |
| 1556 | (dolist (channel rcirc-buffer-alist) | 1556 | (dolist (channel rcirc-buffer-alist) |
| 1557 | (kill-buffer (cdr channel)))))) | 1557 | (kill-buffer (cdr channel)))))) |
| 1558 | 1558 | ||
| 1559 | (defun rcirc-change-major-mode-hook () | 1559 | (defun rcirc-change-major-mode-hook () |
| 1560 | "Part the channel when changing the major mode." | 1560 | "Part the channel when changing the major mode." |
| @@ -1565,18 +1565,18 @@ with it." | |||
| 1565 | (let ((buffer (current-buffer))) | 1565 | (let ((buffer (current-buffer))) |
| 1566 | (rcirc-clear-activity buffer) | 1566 | (rcirc-clear-activity buffer) |
| 1567 | (when (and (rcirc-buffer-process) | 1567 | (when (and (rcirc-buffer-process) |
| 1568 | (rcirc--connection-open-p (rcirc-buffer-process))) | 1568 | (rcirc--connection-open-p (rcirc-buffer-process))) |
| 1569 | (with-rcirc-server-buffer | 1569 | (with-rcirc-server-buffer |
| 1570 | (setq rcirc-buffer-alist | 1570 | (setq rcirc-buffer-alist |
| 1571 | (rassq-delete-all buffer rcirc-buffer-alist))) | 1571 | (rassq-delete-all buffer rcirc-buffer-alist))) |
| 1572 | (rcirc-update-short-buffer-names) | 1572 | (rcirc-update-short-buffer-names) |
| 1573 | (if (rcirc-channel-p rcirc-target) | 1573 | (if (rcirc-channel-p rcirc-target) |
| 1574 | (rcirc-send-string (rcirc-buffer-process) | 1574 | (rcirc-send-string (rcirc-buffer-process) |
| 1575 | "PART" rcirc-target : reason) | 1575 | "PART" rcirc-target : reason) |
| 1576 | (when rcirc-target | 1576 | (when rcirc-target |
| 1577 | (rcirc-remove-nick-channel (rcirc-buffer-process) | 1577 | (rcirc-remove-nick-channel (rcirc-buffer-process) |
| 1578 | (rcirc-buffer-nick) | 1578 | (rcirc-buffer-nick) |
| 1579 | rcirc-target)))) | 1579 | rcirc-target)))) |
| 1580 | (setq rcirc-target nil))) | 1580 | (setq rcirc-target nil))) |
| 1581 | 1581 | ||
| 1582 | (defun rcirc-generate-new-buffer-name (process target) | 1582 | (defun rcirc-generate-new-buffer-name (process target) |
| @@ -1594,30 +1594,30 @@ If optional argument SERVER is non-nil, return the server buffer | |||
| 1594 | if there is no existing buffer for TARGET, otherwise return nil." | 1594 | if there is no existing buffer for TARGET, otherwise return nil." |
| 1595 | (with-rcirc-process-buffer process | 1595 | (with-rcirc-process-buffer process |
| 1596 | (if (null target) | 1596 | (if (null target) |
| 1597 | (current-buffer) | 1597 | (current-buffer) |
| 1598 | (let ((buffer (cdr (assoc-string target rcirc-buffer-alist t)))) | 1598 | (let ((buffer (cdr (assoc-string target rcirc-buffer-alist t)))) |
| 1599 | (or buffer (when server (current-buffer))))))) | 1599 | (or buffer (when server (current-buffer))))))) |
| 1600 | 1600 | ||
| 1601 | (defun rcirc-get-buffer-create (process target) | 1601 | (defun rcirc-get-buffer-create (process target) |
| 1602 | "Return the buffer associated with the PROCESS and TARGET. | 1602 | "Return the buffer associated with the PROCESS and TARGET. |
| 1603 | Create the buffer if it doesn't exist." | 1603 | Create the buffer if it doesn't exist." |
| 1604 | (let ((buffer (rcirc-get-buffer process target))) | 1604 | (let ((buffer (rcirc-get-buffer process target))) |
| 1605 | (if (and buffer (buffer-live-p buffer)) | 1605 | (if (and buffer (buffer-live-p buffer)) |
| 1606 | (with-current-buffer buffer | 1606 | (with-current-buffer buffer |
| 1607 | (when (not rcirc-target) | 1607 | (when (not rcirc-target) |
| 1608 | (setq rcirc-target target)) | 1608 | (setq rcirc-target target)) |
| 1609 | buffer) | 1609 | buffer) |
| 1610 | ;; create the buffer | 1610 | ;; create the buffer |
| 1611 | (with-rcirc-process-buffer process | 1611 | (with-rcirc-process-buffer process |
| 1612 | (let ((new-buffer (get-buffer-create | 1612 | (let ((new-buffer (get-buffer-create |
| 1613 | (rcirc-generate-new-buffer-name process target)))) | 1613 | (rcirc-generate-new-buffer-name process target)))) |
| 1614 | (with-current-buffer new-buffer | 1614 | (with-current-buffer new-buffer |
| 1615 | (unless (eq major-mode 'rcirc-mode) | 1615 | (unless (eq major-mode 'rcirc-mode) |
| 1616 | (rcirc-mode process target)) | 1616 | (rcirc-mode process target)) |
| 1617 | (setq mode-line-process nil)) | 1617 | (setq mode-line-process nil)) |
| 1618 | (rcirc-put-nick-channel process (rcirc-nick process) target | 1618 | (rcirc-put-nick-channel process (rcirc-nick process) target |
| 1619 | rcirc-current-line) | 1619 | rcirc-current-line) |
| 1620 | new-buffer))))) | 1620 | new-buffer))))) |
| 1621 | 1621 | ||
| 1622 | (defun rcirc-send-input () | 1622 | (defun rcirc-send-input () |
| 1623 | "Send input to target associated with the current buffer." | 1623 | "Send input to target associated with the current buffer." |
| @@ -1625,31 +1625,31 @@ Create the buffer if it doesn't exist." | |||
| 1625 | (if (< (point) rcirc-prompt-end-marker) | 1625 | (if (< (point) rcirc-prompt-end-marker) |
| 1626 | ;; copy the line down to the input area | 1626 | ;; copy the line down to the input area |
| 1627 | (progn | 1627 | (progn |
| 1628 | (forward-line 0) | 1628 | (forward-line 0) |
| 1629 | (let ((start (if (eq (point) (point-min)) | 1629 | (let ((start (if (eq (point) (point-min)) |
| 1630 | (point) | 1630 | (point) |
| 1631 | (if (get-text-property (1- (point)) 'hard) | 1631 | (if (get-text-property (1- (point)) 'hard) |
| 1632 | (point) | 1632 | (point) |
| 1633 | (previous-single-property-change (point) 'hard)))) | 1633 | (previous-single-property-change (point) 'hard)))) |
| 1634 | (end (next-single-property-change (1+ (point)) 'hard))) | 1634 | (end (next-single-property-change (1+ (point)) 'hard))) |
| 1635 | (goto-char (point-max)) | 1635 | (goto-char (point-max)) |
| 1636 | (insert (replace-regexp-in-string | 1636 | (insert (replace-regexp-in-string |
| 1637 | "\n\\s-+" " " | 1637 | "\n\\s-+" " " |
| 1638 | (buffer-substring-no-properties start end))))) | 1638 | (buffer-substring-no-properties start end))))) |
| 1639 | ;; process input | 1639 | ;; process input |
| 1640 | (goto-char (point-max)) | 1640 | (goto-char (point-max)) |
| 1641 | (when (not (equal 0 (- (point) rcirc-prompt-end-marker))) | 1641 | (when (not (equal 0 (- (point) rcirc-prompt-end-marker))) |
| 1642 | ;; delete a trailing newline | 1642 | ;; delete a trailing newline |
| 1643 | (when (eq (point) (line-beginning-position)) | 1643 | (when (eq (point) (line-beginning-position)) |
| 1644 | (delete-char -1)) | 1644 | (delete-char -1)) |
| 1645 | (let ((input (buffer-substring-no-properties | 1645 | (let ((input (buffer-substring-no-properties |
| 1646 | rcirc-prompt-end-marker (point)))) | 1646 | rcirc-prompt-end-marker (point)))) |
| 1647 | (dolist (line (split-string input "\n")) | 1647 | (dolist (line (split-string input "\n")) |
| 1648 | (rcirc-process-input-line line)) | 1648 | (rcirc-process-input-line line)) |
| 1649 | ;; add to input-ring | 1649 | ;; add to input-ring |
| 1650 | (save-excursion | 1650 | (save-excursion |
| 1651 | (ring-insert rcirc-input-ring input) | 1651 | (ring-insert rcirc-input-ring input) |
| 1652 | (setq rcirc-input-ring-index 0)))))) | 1652 | (setq rcirc-input-ring-index 0)))))) |
| 1653 | 1653 | ||
| 1654 | (defun rcirc-fill-paragraph (&optional justify) | 1654 | (defun rcirc-fill-paragraph (&optional justify) |
| 1655 | "Implementation for `fill-paragraph-function'. | 1655 | "Implementation for `fill-paragraph-function'. |
| @@ -1659,14 +1659,14 @@ The argument JUSTIFY is passed on to `fill-region'." | |||
| 1659 | (save-restriction | 1659 | (save-restriction |
| 1660 | (narrow-to-region rcirc-prompt-end-marker (point-max)) | 1660 | (narrow-to-region rcirc-prompt-end-marker (point-max)) |
| 1661 | (let ((fill-column rcirc-max-message-length)) | 1661 | (let ((fill-column rcirc-max-message-length)) |
| 1662 | (fill-region (point-min) (point-max) justify))))) | 1662 | (fill-region (point-min) (point-max) justify))))) |
| 1663 | 1663 | ||
| 1664 | (defun rcirc-process-input-line (line) | 1664 | (defun rcirc-process-input-line (line) |
| 1665 | "Process LINE as a message or a command." | 1665 | "Process LINE as a message or a command." |
| 1666 | (if (string-match "^/\\([^/ ][^ ]*\\) ?\\(.*\\)$" line) | 1666 | (if (string-match "^/\\([^/ ][^ ]*\\) ?\\(.*\\)$" line) |
| 1667 | (rcirc-process-command (match-string 1 line) | 1667 | (rcirc-process-command (match-string 1 line) |
| 1668 | (match-string 2 line) | 1668 | (match-string 2 line) |
| 1669 | line) | 1669 | line) |
| 1670 | (rcirc-process-message line))) | 1670 | (rcirc-process-message line))) |
| 1671 | 1671 | ||
| 1672 | (defun rcirc-process-message (line) | 1672 | (defun rcirc-process-message (line) |
| @@ -1687,19 +1687,19 @@ The argument JUSTIFY is passed on to `fill-region'." | |||
| 1687 | LINE is the raw input, from which COMMAND and ARGS was | 1687 | LINE is the raw input, from which COMMAND and ARGS was |
| 1688 | extracted." | 1688 | extracted." |
| 1689 | (let ((fun (intern-soft (concat "rcirc-cmd-" command))) | 1689 | (let ((fun (intern-soft (concat "rcirc-cmd-" command))) |
| 1690 | (process (rcirc-buffer-process))) | 1690 | (process (rcirc-buffer-process))) |
| 1691 | (newline) | 1691 | (newline) |
| 1692 | (with-current-buffer (current-buffer) | 1692 | (with-current-buffer (current-buffer) |
| 1693 | (delete-region rcirc-prompt-end-marker (point)) | 1693 | (delete-region rcirc-prompt-end-marker (point)) |
| 1694 | (if (string= command "me") | 1694 | (if (string= command "me") |
| 1695 | (rcirc-print process (rcirc-buffer-nick) | 1695 | (rcirc-print process (rcirc-buffer-nick) |
| 1696 | "ACTION" rcirc-target args) | 1696 | "ACTION" rcirc-target args) |
| 1697 | (rcirc-print process (rcirc-buffer-nick) | 1697 | (rcirc-print process (rcirc-buffer-nick) |
| 1698 | "COMMAND" rcirc-target line)) | 1698 | "COMMAND" rcirc-target line)) |
| 1699 | (set-marker rcirc-prompt-end-marker (point)) | 1699 | (set-marker rcirc-prompt-end-marker (point)) |
| 1700 | (if (fboundp fun) | 1700 | (if (fboundp fun) |
| 1701 | (funcall fun args process rcirc-target) | 1701 | (funcall fun args process rcirc-target) |
| 1702 | (rcirc-send-string process command : args))))) | 1702 | (rcirc-send-string process command : args))))) |
| 1703 | 1703 | ||
| 1704 | (defvar-local rcirc-parent-buffer nil | 1704 | (defvar-local rcirc-parent-buffer nil |
| 1705 | "Message buffer that requested a multiline buffer.") | 1705 | "Message buffer that requested a multiline buffer.") |
| @@ -1714,7 +1714,7 @@ extracted." | |||
| 1714 | (let ((pos (1+ (- (point) rcirc-prompt-end-marker)))) | 1714 | (let ((pos (1+ (- (point) rcirc-prompt-end-marker)))) |
| 1715 | (goto-char (point-max)) | 1715 | (goto-char (point-max)) |
| 1716 | (let ((text (buffer-substring-no-properties rcirc-prompt-end-marker | 1716 | (let ((text (buffer-substring-no-properties rcirc-prompt-end-marker |
| 1717 | (point))) | 1717 | (point))) |
| 1718 | (parent (buffer-name))) | 1718 | (parent (buffer-name))) |
| 1719 | (delete-region rcirc-prompt-end-marker (point)) | 1719 | (delete-region rcirc-prompt-end-marker (point)) |
| 1720 | (setq rcirc-window-configuration (current-window-configuration)) | 1720 | (setq rcirc-window-configuration (current-window-configuration)) |
| @@ -1768,11 +1768,11 @@ extracted." | |||
| 1768 | (process-buffer process) | 1768 | (process-buffer process) |
| 1769 | (let ((buffer (window-buffer))) | 1769 | (let ((buffer (window-buffer))) |
| 1770 | (if (and buffer | 1770 | (if (and buffer |
| 1771 | (with-current-buffer buffer | 1771 | (with-current-buffer buffer |
| 1772 | (and (eq major-mode 'rcirc-mode) | 1772 | (and (eq major-mode 'rcirc-mode) |
| 1773 | (eq (rcirc-buffer-process) process)))) | 1773 | (eq (rcirc-buffer-process) process)))) |
| 1774 | buffer | 1774 | buffer |
| 1775 | (process-buffer process))))) | 1775 | (process-buffer process))))) |
| 1776 | 1776 | ||
| 1777 | (defcustom rcirc-response-formats | 1777 | (defcustom rcirc-response-formats |
| 1778 | '(("PRIVMSG" . "<%N> %m") | 1778 | '(("PRIVMSG" . "<%N> %m") |
| @@ -1803,7 +1803,7 @@ the of the following escape sequences replaced by the described values: | |||
| 1803 | %f- Following text uses the default face | 1803 | %f- Following text uses the default face |
| 1804 | %% A literal `%' character" | 1804 | %% A literal `%' character" |
| 1805 | :type '(alist :key-type (choice (string :tag "Type") | 1805 | :type '(alist :key-type (choice (string :tag "Type") |
| 1806 | (const :tag "Default" t)) | 1806 | (const :tag "Default" t)) |
| 1807 | :value-type string)) | 1807 | :value-type string)) |
| 1808 | 1808 | ||
| 1809 | (defun rcirc-format-response-string (process sender response target text) | 1809 | (defun rcirc-format-response-string (process sender response target text) |
| @@ -1813,55 +1813,55 @@ The specific formatting used is found by looking up RESPONSE in | |||
| 1813 | communication." | 1813 | communication." |
| 1814 | (with-temp-buffer | 1814 | (with-temp-buffer |
| 1815 | (insert (or (cdr (assoc response rcirc-response-formats)) | 1815 | (insert (or (cdr (assoc response rcirc-response-formats)) |
| 1816 | (cdr (assq t rcirc-response-formats)))) | 1816 | (cdr (assq t rcirc-response-formats)))) |
| 1817 | (goto-char (point-min)) | 1817 | (goto-char (point-min)) |
| 1818 | (let ((start (point-min)) | 1818 | (let ((start (point-min)) |
| 1819 | (sender (if (or (not sender) | 1819 | (sender (if (or (not sender) |
| 1820 | (string= (rcirc-server-name process) sender)) | 1820 | (string= (rcirc-server-name process) sender)) |
| 1821 | "" | 1821 | "" |
| 1822 | (funcall rcirc-nick-filter sender))) | 1822 | (funcall rcirc-nick-filter sender))) |
| 1823 | face) | 1823 | face) |
| 1824 | (while (re-search-forward "%\\(\\(f\\(.\\)\\)\\|\\(.\\)\\)" nil t) | 1824 | (while (re-search-forward "%\\(\\(f\\(.\\)\\)\\|\\(.\\)\\)" nil t) |
| 1825 | (rcirc-add-face start (match-beginning 0) face) | 1825 | (rcirc-add-face start (match-beginning 0) face) |
| 1826 | (setq start (match-beginning 0)) | 1826 | (setq start (match-beginning 0)) |
| 1827 | (replace-match | 1827 | (replace-match |
| 1828 | (cl-case (aref (match-string 1) 0) | 1828 | (cl-case (aref (match-string 1) 0) |
| 1829 | (?f (setq face | 1829 | (?f (setq face |
| 1830 | (cl-case (string-to-char (match-string 3)) | 1830 | (cl-case (string-to-char (match-string 3)) |
| 1831 | (?w 'font-lock-warning-face) | 1831 | (?w 'font-lock-warning-face) |
| 1832 | (?p 'rcirc-server-prefix) | 1832 | (?p 'rcirc-server-prefix) |
| 1833 | (?s 'rcirc-server) | 1833 | (?s 'rcirc-server) |
| 1834 | (t nil))) | 1834 | (t nil))) |
| 1835 | "") | 1835 | "") |
| 1836 | (?n sender) | 1836 | (?n sender) |
| 1837 | (?N (let ((my-nick (rcirc-nick process))) | 1837 | (?N (let ((my-nick (rcirc-nick process))) |
| 1838 | (save-match-data | 1838 | (save-match-data |
| 1839 | (with-syntax-table rcirc-nick-syntax-table | 1839 | (with-syntax-table rcirc-nick-syntax-table |
| 1840 | (rcirc-facify sender | 1840 | (rcirc-facify sender |
| 1841 | (cond ((string= sender my-nick) | 1841 | (cond ((string= sender my-nick) |
| 1842 | 'rcirc-my-nick) | 1842 | 'rcirc-my-nick) |
| 1843 | ((and rcirc-bright-nicks | 1843 | ((and rcirc-bright-nicks |
| 1844 | (string-match | 1844 | (string-match |
| 1845 | (regexp-opt rcirc-bright-nicks | 1845 | (regexp-opt rcirc-bright-nicks |
| 1846 | 'words) | 1846 | 'words) |
| 1847 | sender)) | 1847 | sender)) |
| 1848 | 'rcirc-bright-nick) | 1848 | 'rcirc-bright-nick) |
| 1849 | ((and rcirc-dim-nicks | 1849 | ((and rcirc-dim-nicks |
| 1850 | (string-match | 1850 | (string-match |
| 1851 | (regexp-opt rcirc-dim-nicks | 1851 | (regexp-opt rcirc-dim-nicks |
| 1852 | 'words) | 1852 | 'words) |
| 1853 | sender)) | 1853 | sender)) |
| 1854 | 'rcirc-dim-nick) | 1854 | 'rcirc-dim-nick) |
| 1855 | (t | 1855 | (t |
| 1856 | 'rcirc-other-nick))))))) | 1856 | 'rcirc-other-nick))))))) |
| 1857 | (?m (propertize text 'rcirc-text text)) | 1857 | (?m (propertize text 'rcirc-text text)) |
| 1858 | (?r response) | 1858 | (?r response) |
| 1859 | (?t (or target "")) | 1859 | (?t (or target "")) |
| 1860 | (t (concat "UNKNOWN CODE:" (match-string 0)))) | 1860 | (t (concat "UNKNOWN CODE:" (match-string 0)))) |
| 1861 | t t nil 0) | 1861 | t t nil 0) |
| 1862 | (rcirc-add-face (match-beginning 0) (match-end 0) face)) | 1862 | (rcirc-add-face (match-beginning 0) (match-end 0) face)) |
| 1863 | (rcirc-add-face start (match-beginning 0) face)) | 1863 | (rcirc-add-face start (match-beginning 0) face)) |
| 1864 | (buffer-substring (point-min) (point-max)))) | 1864 | (buffer-substring (point-min) (point-max)))) |
| 1865 | 1865 | ||
| 1866 | (defun rcirc-target-buffer (process sender response target _text) | 1866 | (defun rcirc-target-buffer (process sender response target _text) |
| 1867 | "Return a buffer to print the server response from SENDER. | 1867 | "Return a buffer to print the server response from SENDER. |
| @@ -1869,17 +1869,17 @@ PROCESS is the process object for the current connection." | |||
| 1869 | (cl-assert (not (bufferp target))) | 1869 | (cl-assert (not (bufferp target))) |
| 1870 | (with-rcirc-process-buffer process | 1870 | (with-rcirc-process-buffer process |
| 1871 | (cond ((not target) | 1871 | (cond ((not target) |
| 1872 | (rcirc-any-buffer process)) | 1872 | (rcirc-any-buffer process)) |
| 1873 | ((not (rcirc-channel-p target)) | 1873 | ((not (rcirc-channel-p target)) |
| 1874 | ;; message from another user | 1874 | ;; message from another user |
| 1875 | (if (or (string= response "PRIVMSG") | 1875 | (if (or (string= response "PRIVMSG") |
| 1876 | (string= response "ACTION")) | 1876 | (string= response "ACTION")) |
| 1877 | (rcirc-get-buffer-create process (if (string= sender rcirc-nick) | 1877 | (rcirc-get-buffer-create process (if (string= sender rcirc-nick) |
| 1878 | target | 1878 | target |
| 1879 | sender)) | 1879 | sender)) |
| 1880 | (rcirc-get-buffer process target t))) | 1880 | (rcirc-get-buffer process target t))) |
| 1881 | ((or (rcirc-get-buffer process target) | 1881 | ((or (rcirc-get-buffer process target) |
| 1882 | (rcirc-any-buffer process)))))) | 1882 | (rcirc-any-buffer process)))))) |
| 1883 | 1883 | ||
| 1884 | (defvar-local rcirc-last-sender nil) | 1884 | (defvar-local rcirc-last-sender nil) |
| 1885 | (defvar-local rcirc-activity-types nil | 1885 | (defvar-local rcirc-activity-types nil |
| @@ -1908,11 +1908,11 @@ PROCESS is the process object for the current connection." | |||
| 1908 | "Return the line from the last activity from NICK in TARGET. | 1908 | "Return the line from the last activity from NICK in TARGET. |
| 1909 | PROCESS is the process object for the current connection." | 1909 | PROCESS is the process object for the current connection." |
| 1910 | (let ((line (or (cdr (assoc-string target | 1910 | (let ((line (or (cdr (assoc-string target |
| 1911 | (gethash nick (with-rcirc-server-buffer | 1911 | (gethash nick (with-rcirc-server-buffer |
| 1912 | rcirc-nick-table)) t)) | 1912 | rcirc-nick-table)) t)) |
| 1913 | (rcirc-last-quit-line process nick target)))) | 1913 | (rcirc-last-quit-line process nick target)))) |
| 1914 | (if line | 1914 | (if line |
| 1915 | line | 1915 | line |
| 1916 | ;;(message "line is nil for %s in %s" nick target) | 1916 | ;;(message "line is nil for %s in %s" nick target) |
| 1917 | nil))) | 1917 | nil))) |
| 1918 | 1918 | ||
| @@ -1921,7 +1921,7 @@ PROCESS is the process object for the current connection." | |||
| 1921 | PROCESS is the process object for the current connection." | 1921 | PROCESS is the process object for the current connection." |
| 1922 | (let ((last-activity-line (rcirc-last-line process nick target))) | 1922 | (let ((last-activity-line (rcirc-last-line process nick target))) |
| 1923 | (when (and last-activity-line | 1923 | (when (and last-activity-line |
| 1924 | (> last-activity-line 0)) | 1924 | (> last-activity-line 0)) |
| 1925 | (- rcirc-current-line last-activity-line)))) | 1925 | (- rcirc-current-line last-activity-line)))) |
| 1926 | 1926 | ||
| 1927 | (defvar rcirc-markup-text-functions | 1927 | (defvar rcirc-markup-text-functions |
| @@ -1945,33 +1945,33 @@ record activity. PROCESS is the process object for the current | |||
| 1945 | connection." | 1945 | connection." |
| 1946 | (or text (setq text "")) | 1946 | (or text (setq text "")) |
| 1947 | (unless (and (or (member sender rcirc-ignore-list) | 1947 | (unless (and (or (member sender rcirc-ignore-list) |
| 1948 | (member (with-syntax-table rcirc-nick-syntax-table | 1948 | (member (with-syntax-table rcirc-nick-syntax-table |
| 1949 | (when (string-match "^\\([^/]\\w*\\)[:,]" text) | 1949 | (when (string-match "^\\([^/]\\w*\\)[:,]" text) |
| 1950 | (match-string 1 text))) | 1950 | (match-string 1 text))) |
| 1951 | rcirc-ignore-list)) | 1951 | rcirc-ignore-list)) |
| 1952 | ;; do not ignore if we sent the message | 1952 | ;; do not ignore if we sent the message |
| 1953 | (not (string= sender (rcirc-nick process)))) | 1953 | (not (string= sender (rcirc-nick process)))) |
| 1954 | (let* ((buffer (rcirc-target-buffer process sender response target text)) | 1954 | (let* ((buffer (rcirc-target-buffer process sender response target text)) |
| 1955 | (time (if-let ((time (rcirc-get-tag "time"))) | 1955 | (time (if-let ((time (rcirc-get-tag "time"))) |
| 1956 | (parse-iso8601-time-string time) | 1956 | (parse-iso8601-time-string time) |
| 1957 | (current-time))) | 1957 | (current-time))) |
| 1958 | (inhibit-read-only t)) | 1958 | (inhibit-read-only t)) |
| 1959 | (with-current-buffer buffer | 1959 | (with-current-buffer buffer |
| 1960 | (let ((moving (= (point) rcirc-prompt-end-marker)) | 1960 | (let ((moving (= (point) rcirc-prompt-end-marker)) |
| 1961 | (old-point (point-marker))) | 1961 | (old-point (point-marker))) |
| 1962 | 1962 | ||
| 1963 | (setq text (decode-coding-string text rcirc-decode-coding-system)) | 1963 | (setq text (decode-coding-string text rcirc-decode-coding-system)) |
| 1964 | (unless (string= sender (rcirc-nick process)) | 1964 | (unless (string= sender (rcirc-nick process)) |
| 1965 | ;; mark the line with overlay arrow | 1965 | ;; mark the line with overlay arrow |
| 1966 | (unless (or (marker-position overlay-arrow-position) | 1966 | (unless (or (marker-position overlay-arrow-position) |
| 1967 | (get-buffer-window (current-buffer)) | 1967 | (get-buffer-window (current-buffer)) |
| 1968 | (member response rcirc-omit-responses)) | 1968 | (member response rcirc-omit-responses)) |
| 1969 | (set-marker overlay-arrow-position | 1969 | (set-marker overlay-arrow-position |
| 1970 | (marker-position rcirc-prompt-start-marker)))) | 1970 | (marker-position rcirc-prompt-start-marker)))) |
| 1971 | 1971 | ||
| 1972 | ;; temporarily set the marker insertion-type because | 1972 | ;; temporarily set the marker insertion-type because |
| 1973 | ;; insert-before-markers results in hidden text in new buffers | 1973 | ;; insert-before-markers results in hidden text in new buffers |
| 1974 | (goto-char rcirc-prompt-start-marker) | 1974 | (goto-char rcirc-prompt-start-marker) |
| 1975 | (catch 'exit | 1975 | (catch 'exit |
| 1976 | (while (not (bobp)) | 1976 | (while (not (bobp)) |
| 1977 | (goto-char (or (previous-single-property-change (point) 'hard) | 1977 | (goto-char (or (previous-single-property-change (point) 'hard) |
| @@ -1981,8 +1981,8 @@ connection." | |||
| 1981 | (next-single-property-change (point) 'hard) | 1981 | (next-single-property-change (point) 'hard) |
| 1982 | (forward-char 1) | 1982 | (forward-char 1) |
| 1983 | (throw 'exit nil)))) | 1983 | (throw 'exit nil)))) |
| 1984 | (set-marker-insertion-type rcirc-prompt-start-marker t) | 1984 | (set-marker-insertion-type rcirc-prompt-start-marker t) |
| 1985 | (set-marker-insertion-type rcirc-prompt-end-marker t) | 1985 | (set-marker-insertion-type rcirc-prompt-end-marker t) |
| 1986 | 1986 | ||
| 1987 | ;; run markup functions | 1987 | ;; run markup functions |
| 1988 | (cl-assert (bolp)) | 1988 | (cl-assert (bolp)) |
| @@ -1990,32 +1990,32 @@ connection." | |||
| 1990 | (save-restriction | 1990 | (save-restriction |
| 1991 | (narrow-to-region (point) (point)) | 1991 | (narrow-to-region (point) (point)) |
| 1992 | (insert (propertize (rcirc-format-response-string process sender response | 1992 | (insert (propertize (rcirc-format-response-string process sender response |
| 1993 | nil text) | 1993 | nil text) |
| 1994 | 'rcirc-msgid (rcirc-get-tag "msgid")) | 1994 | 'rcirc-msgid (rcirc-get-tag "msgid")) |
| 1995 | (propertize "\n" 'hard t)) | 1995 | (propertize "\n" 'hard t)) |
| 1996 | 1996 | ||
| 1997 | ;; squeeze spaces out of text before rcirc-text | 1997 | ;; squeeze spaces out of text before rcirc-text |
| 1998 | (fill-region (point-min) (point-max)) | 1998 | (fill-region (point-min) (point-max)) |
| 1999 | 1999 | ||
| 2000 | (goto-char (or (next-single-property-change (point-min) 'rcirc-text) | 2000 | (goto-char (or (next-single-property-change (point-min) 'rcirc-text) |
| 2001 | (point))) | 2001 | (point))) |
| 2002 | (when (rcirc-buffer-process) | 2002 | (when (rcirc-buffer-process) |
| 2003 | (save-excursion (rcirc-markup-timestamp sender response)) | 2003 | (save-excursion (rcirc-markup-timestamp sender response)) |
| 2004 | (dolist (fn rcirc-markup-text-functions) | 2004 | (dolist (fn rcirc-markup-text-functions) |
| 2005 | (save-excursion (funcall fn sender response))) | 2005 | (save-excursion (funcall fn sender response))) |
| 2006 | (when rcirc-fill-flag | 2006 | (when rcirc-fill-flag |
| 2007 | (save-excursion (rcirc-markup-fill sender response)))) | 2007 | (save-excursion (rcirc-markup-fill sender response)))) |
| 2008 | 2008 | ||
| 2009 | (when rcirc-read-only-flag | 2009 | (when rcirc-read-only-flag |
| 2010 | (add-text-properties (point-min) (point-max) | 2010 | (add-text-properties (point-min) (point-max) |
| 2011 | '(read-only t front-sticky t))) | 2011 | '(read-only t front-sticky t))) |
| 2012 | 2012 | ||
| 2013 | (add-text-properties (point-min) (point-max) | 2013 | (add-text-properties (point-min) (point-max) |
| 2014 | (list 'rcirc-time time)) | 2014 | (list 'rcirc-time time)) |
| 2015 | 2015 | ||
| 2016 | ;; make text omittable | 2016 | ;; make text omittable |
| 2017 | (let ((last-activity-lines (rcirc-elapsed-lines process sender target))) | 2017 | (let ((last-activity-lines (rcirc-elapsed-lines process sender target))) |
| 2018 | (if (and (not (string= (rcirc-nick process) sender)) | 2018 | (if (and (not (string= (rcirc-nick process) sender)) |
| 2019 | (or (member response rcirc-omit-responses) | 2019 | (or (member response rcirc-omit-responses) |
| 2020 | (and (member response rcirc-omit-unless-requested) | 2020 | (and (member response rcirc-omit-unless-requested) |
| 2021 | (if (member response rcirc-pending-requests) | 2021 | (if (member response rcirc-pending-requests) |
| @@ -2025,50 +2025,50 @@ connection." | |||
| 2025 | (or (member response rcirc-omit-unless-requested) | 2025 | (or (member response rcirc-omit-unless-requested) |
| 2026 | (not last-activity-lines) | 2026 | (not last-activity-lines) |
| 2027 | (< rcirc-omit-threshold last-activity-lines))) | 2027 | (< rcirc-omit-threshold last-activity-lines))) |
| 2028 | (put-text-property (point-min) (point-max) | 2028 | (put-text-property (point-min) (point-max) |
| 2029 | 'invisible 'rcirc-omit) | 2029 | 'invisible 'rcirc-omit) |
| 2030 | ;; otherwise increment the line count | 2030 | ;; otherwise increment the line count |
| 2031 | (setq rcirc-current-line (1+ rcirc-current-line)))))) | 2031 | (setq rcirc-current-line (1+ rcirc-current-line)))))) |
| 2032 | 2032 | ||
| 2033 | (set-marker-insertion-type rcirc-prompt-start-marker nil) | 2033 | (set-marker-insertion-type rcirc-prompt-start-marker nil) |
| 2034 | (set-marker-insertion-type rcirc-prompt-end-marker nil) | 2034 | (set-marker-insertion-type rcirc-prompt-end-marker nil) |
| 2035 | 2035 | ||
| 2036 | ;; truncate buffer if it is very long | 2036 | ;; truncate buffer if it is very long |
| 2037 | (save-excursion | 2037 | (save-excursion |
| 2038 | (when (and rcirc-buffer-maximum-lines | 2038 | (when (and rcirc-buffer-maximum-lines |
| 2039 | (> rcirc-buffer-maximum-lines 0) | 2039 | (> rcirc-buffer-maximum-lines 0) |
| 2040 | (= (forward-line (- rcirc-buffer-maximum-lines)) 0)) | 2040 | (= (forward-line (- rcirc-buffer-maximum-lines)) 0)) |
| 2041 | (delete-region (point-min) (point)))) | 2041 | (delete-region (point-min) (point)))) |
| 2042 | 2042 | ||
| 2043 | ;; set the window point for buffers show in windows | 2043 | ;; set the window point for buffers show in windows |
| 2044 | (walk-windows (lambda (w) | 2044 | (walk-windows (lambda (w) |
| 2045 | (when (and (not (eq (selected-window) w)) | 2045 | (when (and (not (eq (selected-window) w)) |
| 2046 | (eq (current-buffer) | 2046 | (eq (current-buffer) |
| 2047 | (window-buffer w)) | 2047 | (window-buffer w)) |
| 2048 | (>= (window-point w) | 2048 | (>= (window-point w) |
| 2049 | rcirc-prompt-end-marker)) | 2049 | rcirc-prompt-end-marker)) |
| 2050 | (set-window-point w (point-max)))) | 2050 | (set-window-point w (point-max)))) |
| 2051 | nil t) | 2051 | nil t) |
| 2052 | 2052 | ||
| 2053 | ;; restore the point | 2053 | ;; restore the point |
| 2054 | (goto-char (if moving rcirc-prompt-end-marker old-point))) | 2054 | (goto-char (if moving rcirc-prompt-end-marker old-point))) |
| 2055 | 2055 | ||
| 2056 | ;; keep window on bottom line if it was already there | 2056 | ;; keep window on bottom line if it was already there |
| 2057 | (when rcirc-scroll-show-maximum-output | 2057 | (when rcirc-scroll-show-maximum-output |
| 2058 | (let ((window (get-buffer-window))) | 2058 | (let ((window (get-buffer-window))) |
| 2059 | (when window | 2059 | (when window |
| 2060 | (with-selected-window window | 2060 | (with-selected-window window |
| 2061 | (when (eq major-mode 'rcirc-mode) | 2061 | (when (eq major-mode 'rcirc-mode) |
| 2062 | (when (<= (- (window-height) | 2062 | (when (<= (- (window-height) |
| 2063 | (count-screen-lines (window-point) | 2063 | (count-screen-lines (window-point) |
| 2064 | (window-start)) | 2064 | (window-start)) |
| 2065 | 1) | 2065 | 1) |
| 2066 | 0) | 2066 | 0) |
| 2067 | (recenter -1))))))) | 2067 | (recenter -1))))))) |
| 2068 | 2068 | ||
| 2069 | ;; flush undo (can we do something smarter here?) | 2069 | ;; flush undo (can we do something smarter here?) |
| 2070 | (buffer-disable-undo) | 2070 | (buffer-disable-undo) |
| 2071 | (buffer-enable-undo) | 2071 | (buffer-enable-undo) |
| 2072 | 2072 | ||
| 2073 | ;; record mode line activity | 2073 | ;; record mode line activity |
| 2074 | (when (and activity | 2074 | (when (and activity |
| @@ -2076,16 +2076,16 @@ connection." | |||
| 2076 | (not (and rcirc-dim-nicks sender | 2076 | (not (and rcirc-dim-nicks sender |
| 2077 | (string-match (regexp-opt rcirc-dim-nicks) sender) | 2077 | (string-match (regexp-opt rcirc-dim-nicks) sender) |
| 2078 | (rcirc-channel-p target)))) | 2078 | (rcirc-channel-p target)))) |
| 2079 | (rcirc-record-activity (current-buffer) | 2079 | (rcirc-record-activity (current-buffer) |
| 2080 | (when (not (rcirc-channel-p rcirc-target)) | 2080 | (when (not (rcirc-channel-p rcirc-target)) |
| 2081 | 'nick))) | 2081 | 'nick))) |
| 2082 | 2082 | ||
| 2083 | (when (and rcirc-log-flag | 2083 | (when (and rcirc-log-flag |
| 2084 | (or target | 2084 | (or target |
| 2085 | rcirc-log-process-buffers)) | 2085 | rcirc-log-process-buffers)) |
| 2086 | (rcirc-log process sender response target text)) | 2086 | (rcirc-log process sender response target text)) |
| 2087 | 2087 | ||
| 2088 | (sit-for 0) ; displayed text before hook | 2088 | (sit-for 0) ; displayed text before hook |
| 2089 | (run-hook-with-args 'rcirc-print-functions | 2089 | (run-hook-with-args 'rcirc-print-functions |
| 2090 | process sender response target text))))) | 2090 | process sender response target text))))) |
| 2091 | 2091 | ||
| @@ -2127,15 +2127,15 @@ disk. PROCESS is the process object for the current connection." | |||
| 2127 | (parse-iso8601-time-string time)))) | 2127 | (parse-iso8601-time-string time)))) |
| 2128 | (unless (null filename) | 2128 | (unless (null filename) |
| 2129 | (let ((cell (assoc-string filename rcirc-log-alist)) | 2129 | (let ((cell (assoc-string filename rcirc-log-alist)) |
| 2130 | (line (concat (format-time-string rcirc-time-format time) | 2130 | (line (concat (format-time-string rcirc-time-format time) |
| 2131 | (substring-no-properties | 2131 | (substring-no-properties |
| 2132 | (rcirc-format-response-string process sender | 2132 | (rcirc-format-response-string process sender |
| 2133 | response target text)) | 2133 | response target text)) |
| 2134 | "\n"))) | 2134 | "\n"))) |
| 2135 | (if cell | 2135 | (if cell |
| 2136 | (setcdr cell (concat (cdr cell) line)) | 2136 | (setcdr cell (concat (cdr cell) line)) |
| 2137 | (setq rcirc-log-alist | 2137 | (setq rcirc-log-alist |
| 2138 | (cons (cons filename line) rcirc-log-alist))))))) | 2138 | (cons (cons filename line) rcirc-log-alist))))))) |
| 2139 | 2139 | ||
| 2140 | (defun rcirc-log-write () | 2140 | (defun rcirc-log-write () |
| 2141 | "Flush `rcirc-log-alist' data to disk. | 2141 | "Flush `rcirc-log-alist' data to disk. |
| @@ -2146,11 +2146,11 @@ log-files with absolute names (see `rcirc-log-filename-function')." | |||
| 2146 | (let ((filename (convert-standard-filename | 2146 | (let ((filename (convert-standard-filename |
| 2147 | (expand-file-name (car cell) | 2147 | (expand-file-name (car cell) |
| 2148 | rcirc-log-directory))) | 2148 | rcirc-log-directory))) |
| 2149 | (coding-system-for-write 'utf-8)) | 2149 | (coding-system-for-write 'utf-8)) |
| 2150 | (make-directory (file-name-directory filename) t) | 2150 | (make-directory (file-name-directory filename) t) |
| 2151 | (with-temp-buffer | 2151 | (with-temp-buffer |
| 2152 | (insert (cdr cell)) | 2152 | (insert (cdr cell)) |
| 2153 | (write-region (point-min) (point-max) filename t 'quiet)))) | 2153 | (write-region (point-min) (point-max) filename t 'quiet)))) |
| 2154 | (setq rcirc-log-alist nil)) | 2154 | (setq rcirc-log-alist nil)) |
| 2155 | 2155 | ||
| 2156 | (defun rcirc-view-log-file () | 2156 | (defun rcirc-view-log-file () |
| @@ -2158,8 +2158,8 @@ log-files with absolute names (see `rcirc-log-filename-function')." | |||
| 2158 | (interactive) | 2158 | (interactive) |
| 2159 | (find-file-other-window | 2159 | (find-file-other-window |
| 2160 | (expand-file-name (funcall rcirc-log-filename-function | 2160 | (expand-file-name (funcall rcirc-log-filename-function |
| 2161 | (rcirc-buffer-process) rcirc-target) | 2161 | (rcirc-buffer-process) rcirc-target) |
| 2162 | rcirc-log-directory))) | 2162 | rcirc-log-directory))) |
| 2163 | 2163 | ||
| 2164 | (defun rcirc-join-channels (process channels) | 2164 | (defun rcirc-join-channels (process channels) |
| 2165 | "Join CHANNELS. | 2165 | "Join CHANNELS. |
| @@ -2167,7 +2167,7 @@ PROCESS is the process object for the current connection." | |||
| 2167 | (save-window-excursion | 2167 | (save-window-excursion |
| 2168 | (dolist (channel channels) | 2168 | (dolist (channel channels) |
| 2169 | (with-rcirc-process-buffer process | 2169 | (with-rcirc-process-buffer process |
| 2170 | (rcirc-cmd-join channel process))))) | 2170 | (rcirc-cmd-join channel process))))) |
| 2171 | 2171 | ||
| 2172 | ;;; nick management | 2172 | ;;; nick management |
| 2173 | (defvar rcirc-nick-prefix-chars '(?~ ?& ?@ ?% ?+) | 2173 | (defvar rcirc-nick-prefix-chars '(?~ ?& ?@ ?% ?+) |
| @@ -2177,9 +2177,9 @@ PROCESS is the process object for the current connection." | |||
| 2177 | "Return the nick from USER. Remove any non-nick junk." | 2177 | "Return the nick from USER. Remove any non-nick junk." |
| 2178 | (save-match-data | 2178 | (save-match-data |
| 2179 | (if (string-match (concat "^[" rcirc-nick-prefix-chars | 2179 | (if (string-match (concat "^[" rcirc-nick-prefix-chars |
| 2180 | "]*\\([^! ]+\\)!?") | 2180 | "]*\\([^! ]+\\)!?") |
| 2181 | (or user "")) | 2181 | (or user "")) |
| 2182 | (match-string 1 user) | 2182 | (match-string 1 user) |
| 2183 | user))) | 2183 | user))) |
| 2184 | 2184 | ||
| 2185 | (defun rcirc-nick-channels (process nick) | 2185 | (defun rcirc-nick-channels (process nick) |
| @@ -2187,7 +2187,7 @@ PROCESS is the process object for the current connection." | |||
| 2187 | PROCESS is the process object for the current connection." | 2187 | PROCESS is the process object for the current connection." |
| 2188 | (with-rcirc-process-buffer process | 2188 | (with-rcirc-process-buffer process |
| 2189 | (mapcar (lambda (x) (car x)) | 2189 | (mapcar (lambda (x) (car x)) |
| 2190 | (gethash nick rcirc-nick-table)))) | 2190 | (gethash nick rcirc-nick-table)))) |
| 2191 | 2191 | ||
| 2192 | (defun rcirc-put-nick-channel (process nick channel &optional line) | 2192 | (defun rcirc-put-nick-channel (process nick channel &optional line) |
| 2193 | "Add CHANNEL to list associated with NICK. | 2193 | "Add CHANNEL to list associated with NICK. |
| @@ -2198,12 +2198,12 @@ to zero. PROCESS is the process object for the current connection." | |||
| 2198 | (let ((nick (rcirc-user-nick nick))) | 2198 | (let ((nick (rcirc-user-nick nick))) |
| 2199 | (with-rcirc-process-buffer process | 2199 | (with-rcirc-process-buffer process |
| 2200 | (let* ((chans (gethash nick rcirc-nick-table)) | 2200 | (let* ((chans (gethash nick rcirc-nick-table)) |
| 2201 | (record (assoc-string channel chans t))) | 2201 | (record (assoc-string channel chans t))) |
| 2202 | (if record | 2202 | (if record |
| 2203 | (when line (setcdr record line)) | 2203 | (when line (setcdr record line)) |
| 2204 | (puthash nick (cons (cons channel (or line 0)) | 2204 | (puthash nick (cons (cons channel (or line 0)) |
| 2205 | chans) | 2205 | chans) |
| 2206 | rcirc-nick-table)))))) | 2206 | rcirc-nick-table)))))) |
| 2207 | 2207 | ||
| 2208 | (defun rcirc-nick-remove (process nick) | 2208 | (defun rcirc-nick-remove (process nick) |
| 2209 | "Remove NICK from table. | 2209 | "Remove NICK from table. |
| @@ -2217,11 +2217,11 @@ PROCESS is the process object for the current connection." | |||
| 2217 | (with-rcirc-process-buffer process | 2217 | (with-rcirc-process-buffer process |
| 2218 | (let* ((chans (gethash nick rcirc-nick-table)) | 2218 | (let* ((chans (gethash nick rcirc-nick-table)) |
| 2219 | (newchans | 2219 | (newchans |
| 2220 | ;; instead of assoc-string-delete-all: | 2220 | ;; instead of assoc-string-delete-all: |
| 2221 | (let ((record (assoc-string channel chans t))) | 2221 | (let ((record (assoc-string channel chans t))) |
| 2222 | (when record | 2222 | (when record |
| 2223 | (setcar record 'delete) | 2223 | (setcar record 'delete) |
| 2224 | (assq-delete-all 'delete chans))))) | 2224 | (assq-delete-all 'delete chans))))) |
| 2225 | (if newchans | 2225 | (if newchans |
| 2226 | (puthash nick newchans rcirc-nick-table) | 2226 | (puthash nick newchans rcirc-nick-table) |
| 2227 | (remhash nick rcirc-nick-table))))) | 2227 | (remhash nick rcirc-nick-table))))) |
| @@ -2231,19 +2231,19 @@ PROCESS is the process object for the current connection." | |||
| 2231 | PROCESS is the process object for the current connection." | 2231 | PROCESS is the process object for the current connection." |
| 2232 | (when target | 2232 | (when target |
| 2233 | (if (rcirc-channel-p target) | 2233 | (if (rcirc-channel-p target) |
| 2234 | (with-rcirc-process-buffer process | 2234 | (with-rcirc-process-buffer process |
| 2235 | (let (nicks) | 2235 | (let (nicks) |
| 2236 | (maphash | 2236 | (maphash |
| 2237 | (lambda (k v) | 2237 | (lambda (k v) |
| 2238 | (let ((record (assoc-string target v t))) | 2238 | (let ((record (assoc-string target v t))) |
| 2239 | (if record | 2239 | (if record |
| 2240 | (setq nicks (cons (cons k (cdr record)) nicks))))) | 2240 | (setq nicks (cons (cons k (cdr record)) nicks))))) |
| 2241 | rcirc-nick-table) | 2241 | rcirc-nick-table) |
| 2242 | (mapcar (lambda (x) (car x)) | 2242 | (mapcar (lambda (x) (car x)) |
| 2243 | (sort nicks (lambda (x y) | 2243 | (sort nicks (lambda (x y) |
| 2244 | (let ((lx (or (cdr x) 0)) | 2244 | (let ((lx (or (cdr x) 0)) |
| 2245 | (ly (or (cdr y) 0))) | 2245 | (ly (or (cdr y) 0))) |
| 2246 | (< ly lx))))))) | 2246 | (< ly lx))))))) |
| 2247 | (list target)))) | 2247 | (list target)))) |
| 2248 | 2248 | ||
| 2249 | (defun rcirc-ignore-update-automatic (nick) | 2249 | (defun rcirc-ignore-update-automatic (nick) |
| @@ -2251,10 +2251,10 @@ PROCESS is the process object for the current connection." | |||
| 2251 | If so, remove from `rcirc-ignore-list'. PROCESS is the process | 2251 | If so, remove from `rcirc-ignore-list'. PROCESS is the process |
| 2252 | object for the current connection." | 2252 | object for the current connection." |
| 2253 | (when (member nick rcirc-ignore-list-automatic) | 2253 | (when (member nick rcirc-ignore-list-automatic) |
| 2254 | (setq rcirc-ignore-list-automatic | 2254 | (setq rcirc-ignore-list-automatic |
| 2255 | (delete nick rcirc-ignore-list-automatic) | 2255 | (delete nick rcirc-ignore-list-automatic) |
| 2256 | rcirc-ignore-list | 2256 | rcirc-ignore-list |
| 2257 | (delete nick rcirc-ignore-list)))) | 2257 | (delete nick rcirc-ignore-list)))) |
| 2258 | 2258 | ||
| 2259 | (defun rcirc-nickname< (s1 s2) | 2259 | (defun rcirc-nickname< (s1 s2) |
| 2260 | "Return non-nil if IRC nickname S1 is less than S2, and nil otherwise. | 2260 | "Return non-nil if IRC nickname S1 is less than S2, and nil otherwise. |
| @@ -2300,15 +2300,15 @@ This function does not alter the INPUT string." | |||
| 2300 | ;; toggle the mode-line channel indicator | 2300 | ;; toggle the mode-line channel indicator |
| 2301 | (if rcirc-track-minor-mode | 2301 | (if rcirc-track-minor-mode |
| 2302 | (progn | 2302 | (progn |
| 2303 | (and (not (memq 'rcirc-activity-string global-mode-string)) | 2303 | (and (not (memq 'rcirc-activity-string global-mode-string)) |
| 2304 | (setq global-mode-string | 2304 | (setq global-mode-string |
| 2305 | (append global-mode-string '(rcirc-activity-string)))) | 2305 | (append global-mode-string '(rcirc-activity-string)))) |
| 2306 | (add-hook 'window-configuration-change-hook | 2306 | (add-hook 'window-configuration-change-hook |
| 2307 | 'rcirc-window-configuration-change)) | 2307 | 'rcirc-window-configuration-change)) |
| 2308 | (setq global-mode-string | 2308 | (setq global-mode-string |
| 2309 | (delete 'rcirc-activity-string global-mode-string)) | 2309 | (delete 'rcirc-activity-string global-mode-string)) |
| 2310 | (remove-hook 'window-configuration-change-hook | 2310 | (remove-hook 'window-configuration-change-hook |
| 2311 | 'rcirc-window-configuration-change))) | 2311 | 'rcirc-window-configuration-change))) |
| 2312 | 2312 | ||
| 2313 | (add-to-list 'minor-mode-alist '(rcirc-ignore-buffer-activity-flag " Ignore")) | 2313 | (add-to-list 'minor-mode-alist '(rcirc-ignore-buffer-activity-flag " Ignore")) |
| 2314 | (add-to-list 'minor-mode-alist '(rcirc-low-priority-flag " LowPri")) | 2314 | (add-to-list 'minor-mode-alist '(rcirc-low-priority-flag " LowPri")) |
| @@ -2317,20 +2317,20 @@ This function does not alter the INPUT string." | |||
| 2317 | "Toggle the value of `rcirc-ignore-buffer-activity-flag'." | 2317 | "Toggle the value of `rcirc-ignore-buffer-activity-flag'." |
| 2318 | (interactive) | 2318 | (interactive) |
| 2319 | (setq rcirc-ignore-buffer-activity-flag | 2319 | (setq rcirc-ignore-buffer-activity-flag |
| 2320 | (not rcirc-ignore-buffer-activity-flag)) | 2320 | (not rcirc-ignore-buffer-activity-flag)) |
| 2321 | (message (if rcirc-ignore-buffer-activity-flag | 2321 | (message (if rcirc-ignore-buffer-activity-flag |
| 2322 | "Ignore activity in this buffer" | 2322 | "Ignore activity in this buffer" |
| 2323 | "Notice activity in this buffer")) | 2323 | "Notice activity in this buffer")) |
| 2324 | (force-mode-line-update)) | 2324 | (force-mode-line-update)) |
| 2325 | 2325 | ||
| 2326 | (defun rcirc-toggle-low-priority () | 2326 | (defun rcirc-toggle-low-priority () |
| 2327 | "Toggle the value of `rcirc-low-priority-flag'." | 2327 | "Toggle the value of `rcirc-low-priority-flag'." |
| 2328 | (interactive) | 2328 | (interactive) |
| 2329 | (setq rcirc-low-priority-flag | 2329 | (setq rcirc-low-priority-flag |
| 2330 | (not rcirc-low-priority-flag)) | 2330 | (not rcirc-low-priority-flag)) |
| 2331 | (message (if rcirc-low-priority-flag | 2331 | (message (if rcirc-low-priority-flag |
| 2332 | "Activity in this buffer is low priority" | 2332 | "Activity in this buffer is low priority" |
| 2333 | "Activity in this buffer is normal priority")) | 2333 | "Activity in this buffer is normal priority")) |
| 2334 | (force-mode-line-update)) | 2334 | (force-mode-line-update)) |
| 2335 | 2335 | ||
| 2336 | (defun rcirc-switch-to-server-buffer () | 2336 | (defun rcirc-switch-to-server-buffer () |
| @@ -2358,14 +2358,14 @@ This function does not alter the INPUT string." | |||
| 2358 | With prefix ARG, go to the next low priority buffer with activity." | 2358 | With prefix ARG, go to the next low priority buffer with activity." |
| 2359 | (interactive "P") | 2359 | (interactive "P") |
| 2360 | (let* ((pair (rcirc-split-activity rcirc-activity)) | 2360 | (let* ((pair (rcirc-split-activity rcirc-activity)) |
| 2361 | (lopri (car pair)) | 2361 | (lopri (car pair)) |
| 2362 | (hipri (cdr pair))) | 2362 | (hipri (cdr pair))) |
| 2363 | (if (or (and (not arg) hipri) | 2363 | (if (or (and (not arg) hipri) |
| 2364 | (and arg lopri)) | 2364 | (and arg lopri)) |
| 2365 | (progn | 2365 | (progn |
| 2366 | (switch-to-buffer (car (if arg lopri hipri))) | 2366 | (switch-to-buffer (car (if arg lopri hipri))) |
| 2367 | (when (> (point) rcirc-prompt-start-marker) | 2367 | (when (> (point) rcirc-prompt-start-marker) |
| 2368 | (recenter -1))) | 2368 | (recenter -1))) |
| 2369 | (rcirc-bury-buffers) | 2369 | (rcirc-bury-buffers) |
| 2370 | (message "No IRC activity.%s" | 2370 | (message "No IRC activity.%s" |
| 2371 | (if lopri | 2371 | (if lopri |
| @@ -2388,21 +2388,21 @@ activity. Only run if the buffer is not visible and | |||
| 2388 | "Record BUFFER activity with TYPE." | 2388 | "Record BUFFER activity with TYPE." |
| 2389 | (with-current-buffer buffer | 2389 | (with-current-buffer buffer |
| 2390 | (let ((old-activity rcirc-activity) | 2390 | (let ((old-activity rcirc-activity) |
| 2391 | (old-types rcirc-activity-types)) | 2391 | (old-types rcirc-activity-types)) |
| 2392 | (when (and (not (get-buffer-window (current-buffer) t)) | 2392 | (when (and (not (get-buffer-window (current-buffer) t)) |
| 2393 | (not (and rcirc-track-ignore-server-buffer-flag | 2393 | (not (and rcirc-track-ignore-server-buffer-flag |
| 2394 | (eq rcirc-server-buffer (current-buffer))))) | 2394 | (eq rcirc-server-buffer (current-buffer))))) |
| 2395 | (setq rcirc-activity | 2395 | (setq rcirc-activity |
| 2396 | (sort (if (memq (current-buffer) rcirc-activity) rcirc-activity | 2396 | (sort (if (memq (current-buffer) rcirc-activity) rcirc-activity |
| 2397 | (cons (current-buffer) rcirc-activity)) | 2397 | (cons (current-buffer) rcirc-activity)) |
| 2398 | (lambda (b1 b2) | 2398 | (lambda (b1 b2) |
| 2399 | (let ((t1 (buffer-local-value 'rcirc-last-post-time b1)) | 2399 | (let ((t1 (buffer-local-value 'rcirc-last-post-time b1)) |
| 2400 | (t2 (buffer-local-value 'rcirc-last-post-time b2))) | 2400 | (t2 (buffer-local-value 'rcirc-last-post-time b2))) |
| 2401 | (time-less-p t2 t1))))) | 2401 | (time-less-p t2 t1))))) |
| 2402 | (cl-pushnew type rcirc-activity-types) | 2402 | (cl-pushnew type rcirc-activity-types) |
| 2403 | (unless (and (equal rcirc-activity old-activity) | 2403 | (unless (and (equal rcirc-activity old-activity) |
| 2404 | (member type old-types)) | 2404 | (member type old-types)) |
| 2405 | (rcirc-update-activity-string))))) | 2405 | (rcirc-update-activity-string))))) |
| 2406 | (run-hook-with-args 'rcirc-activity-functions buffer)) | 2406 | (run-hook-with-args 'rcirc-activity-functions buffer)) |
| 2407 | 2407 | ||
| 2408 | (defun rcirc-clear-activity (buffer) | 2408 | (defun rcirc-clear-activity (buffer) |
| @@ -2422,10 +2422,10 @@ activity. Only run if the buffer is not visible and | |||
| 2422 | (let (lopri hipri) | 2422 | (let (lopri hipri) |
| 2423 | (dolist (buf activity) | 2423 | (dolist (buf activity) |
| 2424 | (with-current-buffer buf | 2424 | (with-current-buffer buf |
| 2425 | (if (and rcirc-low-priority-flag | 2425 | (if (and rcirc-low-priority-flag |
| 2426 | (not (member 'nick rcirc-activity-types))) | 2426 | (not (member 'nick rcirc-activity-types))) |
| 2427 | (push buf lopri) | 2427 | (push buf lopri) |
| 2428 | (push buf hipri)))) | 2428 | (push buf hipri)))) |
| 2429 | (cons (nreverse lopri) (nreverse hipri)))) | 2429 | (cons (nreverse lopri) (nreverse hipri)))) |
| 2430 | 2430 | ||
| 2431 | (defvar rcirc-update-activity-string-hook nil | 2431 | (defvar rcirc-update-activity-string-hook nil |
| @@ -2434,33 +2434,33 @@ activity. Only run if the buffer is not visible and | |||
| 2434 | (defun rcirc-update-activity-string () | 2434 | (defun rcirc-update-activity-string () |
| 2435 | "Update mode-line string." | 2435 | "Update mode-line string." |
| 2436 | (let* ((pair (rcirc-split-activity rcirc-activity)) | 2436 | (let* ((pair (rcirc-split-activity rcirc-activity)) |
| 2437 | (lopri (car pair)) | 2437 | (lopri (car pair)) |
| 2438 | (hipri (cdr pair))) | 2438 | (hipri (cdr pair))) |
| 2439 | (setq rcirc-activity-string | 2439 | (setq rcirc-activity-string |
| 2440 | (cond ((or hipri lopri) | 2440 | (cond ((or hipri lopri) |
| 2441 | (concat (and hipri "[") | 2441 | (concat (and hipri "[") |
| 2442 | (rcirc-activity-string hipri) | 2442 | (rcirc-activity-string hipri) |
| 2443 | (and hipri lopri ",") | 2443 | (and hipri lopri ",") |
| 2444 | (and lopri | 2444 | (and lopri |
| 2445 | (concat "(" | 2445 | (concat "(" |
| 2446 | (rcirc-activity-string lopri) | 2446 | (rcirc-activity-string lopri) |
| 2447 | ")")) | 2447 | ")")) |
| 2448 | (and hipri "]"))) | 2448 | (and hipri "]"))) |
| 2449 | ((not (null (rcirc-process-list))) | 2449 | ((not (null (rcirc-process-list))) |
| 2450 | "[]") | 2450 | "[]") |
| 2451 | (t "[]"))) | 2451 | (t "[]"))) |
| 2452 | (run-hooks 'rcirc-update-activity-string-hook) | 2452 | (run-hooks 'rcirc-update-activity-string-hook) |
| 2453 | (force-mode-line-update t))) | 2453 | (force-mode-line-update t))) |
| 2454 | 2454 | ||
| 2455 | (defun rcirc-activity-string (buffers) | 2455 | (defun rcirc-activity-string (buffers) |
| 2456 | "Generate activity string for all BUFFERS." | 2456 | "Generate activity string for all BUFFERS." |
| 2457 | (mapconcat (lambda (b) | 2457 | (mapconcat (lambda (b) |
| 2458 | (let ((s (substring-no-properties (rcirc-short-buffer-name b)))) | 2458 | (let ((s (substring-no-properties (rcirc-short-buffer-name b)))) |
| 2459 | (with-current-buffer b | 2459 | (with-current-buffer b |
| 2460 | (dolist (type rcirc-activity-types) | 2460 | (dolist (type rcirc-activity-types) |
| 2461 | (rcirc-facify s (cl-case type | 2461 | (rcirc-facify s (cl-case type |
| 2462 | (nick 'rcirc-track-nick) | 2462 | (nick 'rcirc-track-nick) |
| 2463 | (keyword 'rcirc-track-keyword))))) | 2463 | (keyword 'rcirc-track-keyword))))) |
| 2464 | (let ((map (make-mode-line-mouse-map | 2464 | (let ((map (make-mode-line-mouse-map |
| 2465 | 'mouse-1 | 2465 | 'mouse-1 |
| 2466 | (lambda () | 2466 | (lambda () |
| @@ -2469,7 +2469,7 @@ activity. Only run if the buffer is not visible and | |||
| 2469 | (propertize s | 2469 | (propertize s |
| 2470 | 'mouse-face 'mode-line-highlight | 2470 | 'mouse-face 'mode-line-highlight |
| 2471 | 'local-map map)))) | 2471 | 'local-map map)))) |
| 2472 | buffers ",")) | 2472 | buffers ",")) |
| 2473 | 2473 | ||
| 2474 | (defun rcirc-short-buffer-name (buffer) | 2474 | (defun rcirc-short-buffer-name (buffer) |
| 2475 | "Return a short name for BUFFER to use in the mode line indicator." | 2475 | "Return a short name for BUFFER to use in the mode line indicator." |
| @@ -2485,9 +2485,9 @@ activity. Only run if the buffer is not visible and | |||
| 2485 | "Return a list of the visible buffers that are in `rcirc-mode'." | 2485 | "Return a list of the visible buffers that are in `rcirc-mode'." |
| 2486 | (let (acc) | 2486 | (let (acc) |
| 2487 | (walk-windows (lambda (w) | 2487 | (walk-windows (lambda (w) |
| 2488 | (with-current-buffer (window-buffer w) | 2488 | (with-current-buffer (window-buffer w) |
| 2489 | (when (eq major-mode 'rcirc-mode) | 2489 | (when (eq major-mode 'rcirc-mode) |
| 2490 | (push (current-buffer) acc))))) | 2490 | (push (current-buffer) acc))))) |
| 2491 | acc)) | 2491 | acc)) |
| 2492 | 2492 | ||
| 2493 | (defvar rcirc-visible-buffers nil | 2493 | (defvar rcirc-visible-buffers nil |
| @@ -2501,7 +2501,7 @@ activity. Only run if the buffer is not visible and | |||
| 2501 | (defun rcirc-window-configuration-change-1 () | 2501 | (defun rcirc-window-configuration-change-1 () |
| 2502 | "Clear activity and overlay arrows." | 2502 | "Clear activity and overlay arrows." |
| 2503 | (let* ((old-activity rcirc-activity) | 2503 | (let* ((old-activity rcirc-activity) |
| 2504 | (hidden-buffers rcirc-visible-buffers)) | 2504 | (hidden-buffers rcirc-visible-buffers)) |
| 2505 | 2505 | ||
| 2506 | (setq rcirc-visible-buffers (rcirc-visible-buffers)) | 2506 | (setq rcirc-visible-buffers (rcirc-visible-buffers)) |
| 2507 | 2507 | ||
| @@ -2516,8 +2516,8 @@ activity. Only run if the buffer is not visible and | |||
| 2516 | 2516 | ||
| 2517 | ;; remove any killed buffers from list | 2517 | ;; remove any killed buffers from list |
| 2518 | (setq rcirc-activity | 2518 | (setq rcirc-activity |
| 2519 | (delq nil (mapcar (lambda (buf) (when (buffer-live-p buf) buf)) | 2519 | (delq nil (mapcar (lambda (buf) (when (buffer-live-p buf) buf)) |
| 2520 | rcirc-activity))) | 2520 | rcirc-activity))) |
| 2521 | ;; update the mode-line string | 2521 | ;; update the mode-line string |
| 2522 | (unless (equal old-activity rcirc-activity) | 2522 | (unless (equal old-activity rcirc-activity) |
| 2523 | (rcirc-update-activity-string)))) | 2523 | (rcirc-update-activity-string)))) |
| @@ -2527,14 +2527,14 @@ activity. Only run if the buffer is not visible and | |||
| 2527 | (defun rcirc-update-short-buffer-names () | 2527 | (defun rcirc-update-short-buffer-names () |
| 2528 | "Update variable `rcirc-short-buffer-name' for IRC buffers." | 2528 | "Update variable `rcirc-short-buffer-name' for IRC buffers." |
| 2529 | (let ((bufalist | 2529 | (let ((bufalist |
| 2530 | (apply 'append (mapcar (lambda (process) | 2530 | (apply 'append (mapcar (lambda (process) |
| 2531 | (with-rcirc-process-buffer process | 2531 | (with-rcirc-process-buffer process |
| 2532 | rcirc-buffer-alist)) | 2532 | rcirc-buffer-alist)) |
| 2533 | (rcirc-process-list))))) | 2533 | (rcirc-process-list))))) |
| 2534 | (dolist (i (rcirc-abbreviate bufalist)) | 2534 | (dolist (i (rcirc-abbreviate bufalist)) |
| 2535 | (when (buffer-live-p (cdr i)) | 2535 | (when (buffer-live-p (cdr i)) |
| 2536 | (with-current-buffer (cdr i) | 2536 | (with-current-buffer (cdr i) |
| 2537 | (setq rcirc-short-buffer-name (car i))))))) | 2537 | (setq rcirc-short-buffer-name (car i))))))) |
| 2538 | 2538 | ||
| 2539 | (defun rcirc-abbreviate (pairs) | 2539 | (defun rcirc-abbreviate (pairs) |
| 2540 | "Generate alist of abbreviated buffer names to buffers. | 2540 | "Generate alist of abbreviated buffer names to buffers. |
| @@ -2548,12 +2548,12 @@ values, from each process." | |||
| 2548 | acc) | 2548 | acc) |
| 2549 | (dolist (x (cdr tree)) | 2549 | (dolist (x (cdr tree)) |
| 2550 | (if (listp x) | 2550 | (if (listp x) |
| 2551 | (setq acc (append acc | 2551 | (setq acc (append acc |
| 2552 | (mapcar (lambda (y) | 2552 | (mapcar (lambda (y) |
| 2553 | (cons (concat ch (car y)) | 2553 | (cons (concat ch (car y)) |
| 2554 | (cdr y))) | 2554 | (cdr y))) |
| 2555 | (rcirc-rebuild-tree x)))) | 2555 | (rcirc-rebuild-tree x)))) |
| 2556 | (setq acc (cons (cons ch x) acc)))) | 2556 | (setq acc (cons (cons ch x) acc)))) |
| 2557 | acc)) | 2557 | acc)) |
| 2558 | 2558 | ||
| 2559 | (defun rcirc-make-trees (pairs) | 2559 | (defun rcirc-make-trees (pairs) |
| @@ -2565,31 +2565,31 @@ prefix could be found or another tree if it shares the same | |||
| 2565 | prefix with another element in PAIRS." | 2565 | prefix with another element in PAIRS." |
| 2566 | (let (alist) | 2566 | (let (alist) |
| 2567 | (mapc (lambda (pair) | 2567 | (mapc (lambda (pair) |
| 2568 | (if (consp pair) | 2568 | (if (consp pair) |
| 2569 | (let* ((str (car pair)) | 2569 | (let* ((str (car pair)) |
| 2570 | (data (cdr pair)) | 2570 | (data (cdr pair)) |
| 2571 | (char (unless (zerop (length str)) | 2571 | (char (unless (zerop (length str)) |
| 2572 | (aref str 0))) | 2572 | (aref str 0))) |
| 2573 | (rest (unless (zerop (length str)) | 2573 | (rest (unless (zerop (length str)) |
| 2574 | (substring str 1))) | 2574 | (substring str 1))) |
| 2575 | (part (if char (assq char alist)))) | 2575 | (part (if char (assq char alist)))) |
| 2576 | (if part | 2576 | (if part |
| 2577 | ;; existing partition | 2577 | ;; existing partition |
| 2578 | (setcdr part (cons (cons rest data) (cdr part))) | 2578 | (setcdr part (cons (cons rest data) (cdr part))) |
| 2579 | ;; new partition | 2579 | ;; new partition |
| 2580 | (setq alist (cons (if char | 2580 | (setq alist (cons (if char |
| 2581 | (list char (cons rest data)) | 2581 | (list char (cons rest data)) |
| 2582 | data) | 2582 | data) |
| 2583 | alist)))) | 2583 | alist)))) |
| 2584 | (setq alist (cons pair alist)))) | 2584 | (setq alist (cons pair alist)))) |
| 2585 | pairs) | 2585 | pairs) |
| 2586 | ;; recurse into cdrs of alist | 2586 | ;; recurse into cdrs of alist |
| 2587 | (mapc (lambda (x) | 2587 | (mapc (lambda (x) |
| 2588 | (when (and (listp x) (listp (cadr x))) | 2588 | (when (and (listp x) (listp (cadr x))) |
| 2589 | (setcdr x (if (> (length (cdr x)) 1) | 2589 | (setcdr x (if (> (length (cdr x)) 1) |
| 2590 | (rcirc-make-trees (cdr x)) | 2590 | (rcirc-make-trees (cdr x)) |
| 2591 | (setcdr x (list (cdadr x))))))) | 2591 | (setcdr x (list (cdadr x))))))) |
| 2592 | alist))) | 2592 | alist))) |
| 2593 | 2593 | ||
| 2594 | ;;; /commands these are called with 3 args: PROCESS, TARGET, which is | 2594 | ;;; /commands these are called with 3 args: PROCESS, TARGET, which is |
| 2595 | ;; the current buffer/channel/user, and ARGS, which is a string | 2595 | ;; the current buffer/channel/user, and ARGS, which is a string |
| @@ -2666,7 +2666,7 @@ that, an interactive form can specified." | |||
| 2666 | "Send MESSAGE to CHAN-OR-NICK." | 2666 | "Send MESSAGE to CHAN-OR-NICK." |
| 2667 | (interactive (list (completing-read "Message nick: " | 2667 | (interactive (list (completing-read "Message nick: " |
| 2668 | (with-rcirc-server-buffer | 2668 | (with-rcirc-server-buffer |
| 2669 | rcirc-nick-table)) | 2669 | rcirc-nick-table)) |
| 2670 | (read-string "Message: "))) | 2670 | (read-string "Message: "))) |
| 2671 | (rcirc-send-message process chan-or-nick message)) | 2671 | (rcirc-send-message process chan-or-nick message)) |
| 2672 | 2672 | ||
| @@ -2677,7 +2677,7 @@ that, an interactive form can specified." | |||
| 2677 | rcirc-nick-table)))) | 2677 | rcirc-nick-table)))) |
| 2678 | (let ((existing-buffer (rcirc-get-buffer process nick))) | 2678 | (let ((existing-buffer (rcirc-get-buffer process nick))) |
| 2679 | (switch-to-buffer (or existing-buffer | 2679 | (switch-to-buffer (or existing-buffer |
| 2680 | (rcirc-get-buffer-create process nick))) | 2680 | (rcirc-get-buffer-create process nick))) |
| 2681 | (when (not existing-buffer) | 2681 | (when (not existing-buffer) |
| 2682 | (rcirc-cmd-whois nick)))) | 2682 | (rcirc-cmd-whois nick)))) |
| 2683 | 2683 | ||
| @@ -2699,7 +2699,7 @@ CHANNELS is a comma- or space-separated string of channel names." | |||
| 2699 | "Invite NICK to CHANNEL." | 2699 | "Invite NICK to CHANNEL." |
| 2700 | (interactive (list | 2700 | (interactive (list |
| 2701 | (completing-read "Invite nick: " | 2701 | (completing-read "Invite nick: " |
| 2702 | (with-rcirc-server-buffer rcirc-nick-table)) | 2702 | (with-rcirc-server-buffer rcirc-nick-table)) |
| 2703 | (read-string "Channel: "))) | 2703 | (read-string "Channel: "))) |
| 2704 | (rcirc-send-string process "INVITE" nick channel)) | 2704 | (rcirc-send-string process "INVITE" nick channel)) |
| 2705 | 2705 | ||
| @@ -2778,8 +2778,8 @@ With a prefix arg, prompt for new topic." | |||
| 2778 | (interactive (list | 2778 | (interactive (list |
| 2779 | (completing-read "Kick nick: " | 2779 | (completing-read "Kick nick: " |
| 2780 | (rcirc-channel-nicks | 2780 | (rcirc-channel-nicks |
| 2781 | (rcirc-buffer-process) | 2781 | (rcirc-buffer-process) |
| 2782 | rcirc-target)) | 2782 | rcirc-target)) |
| 2783 | (read-from-minibuffer "Kick reason: "))) | 2783 | (read-from-minibuffer "Kick reason: "))) |
| 2784 | (rcirc-send-string process "KICK" target nick : reason)) | 2784 | (rcirc-send-string process "KICK" target nick : reason)) |
| 2785 | 2785 | ||
| @@ -2811,9 +2811,9 @@ PROCESS is the process object for the current connection." | |||
| 2811 | "Toggle membership of ELEMENTS in SET." | 2811 | "Toggle membership of ELEMENTS in SET." |
| 2812 | (dolist (elt elements) | 2812 | (dolist (elt elements) |
| 2813 | (if (and elt (not (string= "" elt))) | 2813 | (if (and elt (not (string= "" elt))) |
| 2814 | (setq set (if (member-ignore-case elt set) | 2814 | (setq set (if (member-ignore-case elt set) |
| 2815 | (delete elt set) | 2815 | (delete elt set) |
| 2816 | (cons elt set))))) | 2816 | (cons elt set))))) |
| 2817 | set) | 2817 | set) |
| 2818 | 2818 | ||
| 2819 | 2819 | ||
| @@ -2824,33 +2824,33 @@ nicks when no NICK is given. When listing ignored nicks, the | |||
| 2824 | ones added to the list automatically are marked with an asterisk." | 2824 | ones added to the list automatically are marked with an asterisk." |
| 2825 | (interactive "sToggle ignoring of nick: ") | 2825 | (interactive "sToggle ignoring of nick: ") |
| 2826 | (setq rcirc-ignore-list | 2826 | (setq rcirc-ignore-list |
| 2827 | (apply #'rcirc-add-or-remove rcirc-ignore-list | 2827 | (apply #'rcirc-add-or-remove rcirc-ignore-list |
| 2828 | (split-string nick nil t))) | 2828 | (split-string nick nil t))) |
| 2829 | (rcirc-print process nil "IGNORE" target | 2829 | (rcirc-print process nil "IGNORE" target |
| 2830 | (mapconcat | 2830 | (mapconcat |
| 2831 | (lambda (nick) | 2831 | (lambda (nick) |
| 2832 | (concat nick | 2832 | (concat nick |
| 2833 | (if (member nick rcirc-ignore-list-automatic) | 2833 | (if (member nick rcirc-ignore-list-automatic) |
| 2834 | "*" ""))) | 2834 | "*" ""))) |
| 2835 | rcirc-ignore-list " "))) | 2835 | rcirc-ignore-list " "))) |
| 2836 | 2836 | ||
| 2837 | (rcirc-define-command bright (nick) | 2837 | (rcirc-define-command bright (nick) |
| 2838 | "Manage the bright nick list." | 2838 | "Manage the bright nick list." |
| 2839 | (interactive "sToggle emphasis of nick: ") | 2839 | (interactive "sToggle emphasis of nick: ") |
| 2840 | (setq rcirc-bright-nicks | 2840 | (setq rcirc-bright-nicks |
| 2841 | (apply #'rcirc-add-or-remove rcirc-bright-nicks | 2841 | (apply #'rcirc-add-or-remove rcirc-bright-nicks |
| 2842 | (split-string nick nil t))) | 2842 | (split-string nick nil t))) |
| 2843 | (rcirc-print process nil "BRIGHT" target | 2843 | (rcirc-print process nil "BRIGHT" target |
| 2844 | (mapconcat 'identity rcirc-bright-nicks " "))) | 2844 | (mapconcat 'identity rcirc-bright-nicks " "))) |
| 2845 | 2845 | ||
| 2846 | (rcirc-define-command dim (nick) | 2846 | (rcirc-define-command dim (nick) |
| 2847 | "Manage the dim nick list." | 2847 | "Manage the dim nick list." |
| 2848 | (interactive "sToggle deemphasis of nick: ") | 2848 | (interactive "sToggle deemphasis of nick: ") |
| 2849 | (setq rcirc-dim-nicks | 2849 | (setq rcirc-dim-nicks |
| 2850 | (apply #'rcirc-add-or-remove rcirc-dim-nicks | 2850 | (apply #'rcirc-add-or-remove rcirc-dim-nicks |
| 2851 | (split-string nick nil t))) | 2851 | (split-string nick nil t))) |
| 2852 | (rcirc-print process nil "DIM" target | 2852 | (rcirc-print process nil "DIM" target |
| 2853 | (mapconcat 'identity rcirc-dim-nicks " "))) | 2853 | (mapconcat 'identity rcirc-dim-nicks " "))) |
| 2854 | 2854 | ||
| 2855 | (rcirc-define-command keyword (keyword) | 2855 | (rcirc-define-command keyword (keyword) |
| 2856 | "Manage the keyword list. | 2856 | "Manage the keyword list. |
| @@ -2858,24 +2858,24 @@ Mark KEYWORD, unmark KEYWORD if already marked, or list marked | |||
| 2858 | keywords when no KEYWORD is given." | 2858 | keywords when no KEYWORD is given." |
| 2859 | (interactive "sToggle highlighting of keyword: ") | 2859 | (interactive "sToggle highlighting of keyword: ") |
| 2860 | (setq rcirc-keywords | 2860 | (setq rcirc-keywords |
| 2861 | (apply #'rcirc-add-or-remove rcirc-keywords | 2861 | (apply #'rcirc-add-or-remove rcirc-keywords |
| 2862 | (split-string keyword nil t))) | 2862 | (split-string keyword nil t))) |
| 2863 | (rcirc-print process nil "KEYWORD" target | 2863 | (rcirc-print process nil "KEYWORD" target |
| 2864 | (mapconcat 'identity rcirc-keywords " "))) | 2864 | (mapconcat 'identity rcirc-keywords " "))) |
| 2865 | 2865 | ||
| 2866 | 2866 | ||
| 2867 | (defun rcirc-add-face (start end name &optional object) | 2867 | (defun rcirc-add-face (start end name &optional object) |
| 2868 | "Add face NAME to the face text property of the text from START to END." | 2868 | "Add face NAME to the face text property of the text from START to END." |
| 2869 | (when name | 2869 | (when name |
| 2870 | (let ((pos start) | 2870 | (let ((pos start) |
| 2871 | next prop) | 2871 | next prop) |
| 2872 | (while (< pos end) | 2872 | (while (< pos end) |
| 2873 | (setq prop (get-text-property pos 'font-lock-face object) | 2873 | (setq prop (get-text-property pos 'font-lock-face object) |
| 2874 | next (next-single-property-change pos 'font-lock-face object end)) | 2874 | next (next-single-property-change pos 'font-lock-face object end)) |
| 2875 | (unless (member name (get-text-property pos 'font-lock-face object)) | 2875 | (unless (member name (get-text-property pos 'font-lock-face object)) |
| 2876 | (add-text-properties pos next | 2876 | (add-text-properties pos next |
| 2877 | (list 'font-lock-face (cons name prop)) object)) | 2877 | (list 'font-lock-face (cons name prop)) object)) |
| 2878 | (setq pos next))))) | 2878 | (setq pos next))))) |
| 2879 | 2879 | ||
| 2880 | (defun rcirc-facify (string face) | 2880 | (defun rcirc-facify (string face) |
| 2881 | "Return a copy of STRING with FACE property added." | 2881 | "Return a copy of STRING with FACE property added." |
| @@ -2917,7 +2917,7 @@ If ARG is given, opens the URL in a new browser window." | |||
| 2917 | (let ((time (and-let* ((time (rcirc-get-tag "time"))) | 2917 | (let ((time (and-let* ((time (rcirc-get-tag "time"))) |
| 2918 | (parse-iso8601-time-string time)))) | 2918 | (parse-iso8601-time-string time)))) |
| 2919 | (insert (rcirc-facify (format-time-string rcirc-time-format time) | 2919 | (insert (rcirc-facify (format-time-string rcirc-time-format time) |
| 2920 | 'rcirc-timestamp)))) | 2920 | 'rcirc-timestamp)))) |
| 2921 | 2921 | ||
| 2922 | (defun rcirc-markup-attributes (_sender _response) | 2922 | (defun rcirc-markup-attributes (_sender _response) |
| 2923 | "Highlight IRC markup, indicated by ASCII control codes." | 2923 | "Highlight IRC markup, indicated by ASCII control codes." |
| @@ -2974,10 +2974,10 @@ If ARG is given, opens the URL in a new browser window." | |||
| 2974 | ((<= 0 bg (1- (length rcirc-color-codes))))) | 2974 | ((<= 0 bg (1- (length rcirc-color-codes))))) |
| 2975 | (setq background (aref rcirc-color-codes bg))) | 2975 | (setq background (aref rcirc-color-codes bg))) |
| 2976 | (rcirc-add-face (match-beginning 0) (match-end 0) | 2976 | (rcirc-add-face (match-beginning 0) (match-end 0) |
| 2977 | `(face (:foreground | 2977 | `(face (:foreground |
| 2978 | ,foreground | 2978 | ,foreground |
| 2979 | :background | 2979 | :background |
| 2980 | ,background)))))) | 2980 | ,background)))))) |
| 2981 | 2981 | ||
| 2982 | (defun rcirc-remove-markup-codes (_sender _response) | 2982 | (defun rcirc-remove-markup-codes (_sender _response) |
| 2983 | "Remove ASCII control codes used to designate markup." | 2983 | "Remove ASCII control codes used to designate markup." |
| @@ -2993,16 +2993,16 @@ If RESPONSE indicates that the nick was mentioned in a message, | |||
| 2993 | highlight the entire line and record the activity." | 2993 | highlight the entire line and record the activity." |
| 2994 | (with-syntax-table rcirc-nick-syntax-table | 2994 | (with-syntax-table rcirc-nick-syntax-table |
| 2995 | (while (re-search-forward (concat "\\b" | 2995 | (while (re-search-forward (concat "\\b" |
| 2996 | (regexp-quote (rcirc-nick | 2996 | (regexp-quote (rcirc-nick |
| 2997 | (rcirc-buffer-process))) | 2997 | (rcirc-buffer-process))) |
| 2998 | "\\b") | 2998 | "\\b") |
| 2999 | nil t) | 2999 | nil t) |
| 3000 | (rcirc-add-face (match-beginning 0) (match-end 0) | 3000 | (rcirc-add-face (match-beginning 0) (match-end 0) |
| 3001 | 'rcirc-nick-in-message) | 3001 | 'rcirc-nick-in-message) |
| 3002 | (when (string= response "PRIVMSG") | 3002 | (when (string= response "PRIVMSG") |
| 3003 | (rcirc-add-face (point-min) (point-max) | 3003 | (rcirc-add-face (point-min) (point-max) |
| 3004 | 'rcirc-nick-in-message-full-line) | 3004 | 'rcirc-nick-in-message-full-line) |
| 3005 | (rcirc-record-activity (current-buffer) 'nick))))) | 3005 | (rcirc-record-activity (current-buffer) 'nick))))) |
| 3006 | 3006 | ||
| 3007 | (defun rcirc-markup-urls (_sender _response) | 3007 | (defun rcirc-markup-urls (_sender _response) |
| 3008 | "Highlight and activate URLs." | 3008 | "Highlight and activate URLs." |
| @@ -3018,11 +3018,11 @@ highlight the entire line and record the activity." | |||
| 3018 | ;; rather than `make-button', as text-buttons are much faster in | 3018 | ;; rather than `make-button', as text-buttons are much faster in |
| 3019 | ;; large buffers. | 3019 | ;; large buffers. |
| 3020 | (make-text-button start (point) | 3020 | (make-text-button start (point) |
| 3021 | 'face 'rcirc-url | 3021 | 'face 'rcirc-url |
| 3022 | 'follow-link t | 3022 | 'follow-link t |
| 3023 | 'rcirc-url url | 3023 | 'rcirc-url url |
| 3024 | 'action (lambda (button) | 3024 | 'action (lambda (button) |
| 3025 | (browse-url-button-open-url | 3025 | (browse-url-button-open-url |
| 3026 | (button-get button 'rcirc-url)))) | 3026 | (button-get button 'rcirc-url)))) |
| 3027 | ;; Record the URL if it is not already the latest stored URL. | 3027 | ;; Record the URL if it is not already the latest stored URL. |
| 3028 | (unless (string= url (caar rcirc-urls)) | 3028 | (unless (string= url (caar rcirc-urls)) |
| @@ -3034,42 +3034,42 @@ Keywords are only highlighted in messages (as indicated by | |||
| 3034 | RESPONSE) when they were not written by the user (as indicated by | 3034 | RESPONSE) when they were not written by the user (as indicated by |
| 3035 | SENDER)." | 3035 | SENDER)." |
| 3036 | (when (and (string= response "PRIVMSG") | 3036 | (when (and (string= response "PRIVMSG") |
| 3037 | (not (string= sender (rcirc-nick (rcirc-buffer-process))))) | 3037 | (not (string= sender (rcirc-nick (rcirc-buffer-process))))) |
| 3038 | (let* ((target (or rcirc-target "")) | 3038 | (let* ((target (or rcirc-target "")) |
| 3039 | (keywords (delq nil (mapcar (lambda (keyword) | 3039 | (keywords (delq nil (mapcar (lambda (keyword) |
| 3040 | (when (not (string-match keyword | 3040 | (when (not (string-match keyword |
| 3041 | target)) | 3041 | target)) |
| 3042 | keyword)) | 3042 | keyword)) |
| 3043 | rcirc-keywords)))) | 3043 | rcirc-keywords)))) |
| 3044 | (when keywords | 3044 | (when keywords |
| 3045 | (while (re-search-forward (regexp-opt keywords 'words) nil t) | 3045 | (while (re-search-forward (regexp-opt keywords 'words) nil t) |
| 3046 | (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-keyword) | 3046 | (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-keyword) |
| 3047 | (rcirc-record-activity (current-buffer) 'keyword)))))) | 3047 | (rcirc-record-activity (current-buffer) 'keyword)))))) |
| 3048 | 3048 | ||
| 3049 | (defun rcirc-markup-bright-nicks (_sender response) | 3049 | (defun rcirc-markup-bright-nicks (_sender response) |
| 3050 | "Highlight nicks brightly as specified by `rcirc-bright-nicks'. | 3050 | "Highlight nicks brightly as specified by `rcirc-bright-nicks'. |
| 3051 | This highlighting only takes place in name lists (as indicated by | 3051 | This highlighting only takes place in name lists (as indicated by |
| 3052 | RESPONSE)." | 3052 | RESPONSE)." |
| 3053 | (when (and rcirc-bright-nicks | 3053 | (when (and rcirc-bright-nicks |
| 3054 | (string= response "NAMES")) | 3054 | (string= response "NAMES")) |
| 3055 | (with-syntax-table rcirc-nick-syntax-table | 3055 | (with-syntax-table rcirc-nick-syntax-table |
| 3056 | (while (re-search-forward (regexp-opt rcirc-bright-nicks 'words) nil t) | 3056 | (while (re-search-forward (regexp-opt rcirc-bright-nicks 'words) nil t) |
| 3057 | (rcirc-add-face (match-beginning 0) (match-end 0) | 3057 | (rcirc-add-face (match-beginning 0) (match-end 0) |
| 3058 | 'rcirc-bright-nick))))) | 3058 | 'rcirc-bright-nick))))) |
| 3059 | 3059 | ||
| 3060 | (defun rcirc-markup-fill (_sender response) | 3060 | (defun rcirc-markup-fill (_sender response) |
| 3061 | "Fill messages as configured by `rcirc-fill-column'. | 3061 | "Fill messages as configured by `rcirc-fill-column'. |
| 3062 | MOTD messages are not filled (as indicated by RESPONSE)." | 3062 | MOTD messages are not filled (as indicated by RESPONSE)." |
| 3063 | (when (not (string= response "372")) ; /motd | 3063 | (when (not (string= response "372")) ; /motd |
| 3064 | (let ((fill-prefix | 3064 | (let ((fill-prefix |
| 3065 | (or rcirc-fill-prefix | 3065 | (or rcirc-fill-prefix |
| 3066 | (make-string (- (point) (line-beginning-position)) ?\s))) | 3066 | (make-string (- (point) (line-beginning-position)) ?\s))) |
| 3067 | (fill-column (- (cond ((null rcirc-fill-column) fill-column) | 3067 | (fill-column (- (cond ((null rcirc-fill-column) fill-column) |
| 3068 | ((functionp rcirc-fill-column) | 3068 | ((functionp rcirc-fill-column) |
| 3069 | (funcall rcirc-fill-column)) | 3069 | (funcall rcirc-fill-column)) |
| 3070 | (t rcirc-fill-column)) | 3070 | (t rcirc-fill-column)) |
| 3071 | ;; make sure ... doesn't cause line wrapping | 3071 | ;; make sure ... doesn't cause line wrapping |
| 3072 | 3))) | 3072 | 3))) |
| 3073 | (fill-region (point) (point-max) nil t)))) | 3073 | (fill-region (point) (point-max) nil t)))) |
| 3074 | 3074 | ||
| 3075 | ;;; handlers | 3075 | ;;; handlers |
| @@ -3098,7 +3098,7 @@ PROCESS is the process object for the current connection." | |||
| 3098 | (setq auth-required t))))) | 3098 | (setq auth-required t))))) |
| 3099 | (if rcirc-authenticate-before-join | 3099 | (if rcirc-authenticate-before-join |
| 3100 | (progn | 3100 | (progn |
| 3101 | (add-hook 'rcirc-authenticated-hook 'rcirc-join-channels-post-auth t t) | 3101 | (add-hook 'rcirc-authenticated-hook 'rcirc-join-channels-post-auth t t) |
| 3102 | (rcirc-authenticate)) | 3102 | (rcirc-authenticate)) |
| 3103 | (rcirc-authenticate) | 3103 | (rcirc-authenticate) |
| 3104 | (rcirc-join-channels process rcirc-startup-channels)) | 3104 | (rcirc-join-channels process rcirc-startup-channels)) |
| @@ -3137,18 +3137,18 @@ PROCESS is the process object for the current connection." | |||
| 3137 | (message (cadr args))) | 3137 | (message (cadr args))) |
| 3138 | (if (string-match "^\C-a\\(.*\\)\C-a$" message) | 3138 | (if (string-match "^\C-a\\(.*\\)\C-a$" message) |
| 3139 | (rcirc-handler-CTCP-response process target sender | 3139 | (rcirc-handler-CTCP-response process target sender |
| 3140 | (match-string 1 message)) | 3140 | (match-string 1 message)) |
| 3141 | (rcirc-print process sender "NOTICE" | 3141 | (rcirc-print process sender "NOTICE" |
| 3142 | (cond ((rcirc-channel-p target) | 3142 | (cond ((rcirc-channel-p target) |
| 3143 | target) | 3143 | target) |
| 3144 | ;; -ChanServ- [#gnu] Welcome... | 3144 | ;; -ChanServ- [#gnu] Welcome... |
| 3145 | ((string-match "\\[\\(#[^] ]+\\)\\]" message) | 3145 | ((string-match "\\[\\(#[^] ]+\\)\\]" message) |
| 3146 | (match-string 1 message)) | 3146 | (match-string 1 message)) |
| 3147 | (sender | 3147 | (sender |
| 3148 | (if (string= sender (rcirc-server-name process)) | 3148 | (if (string= sender (rcirc-server-name process)) |
| 3149 | nil ; server notice | 3149 | nil ; server notice |
| 3150 | sender))) | 3150 | sender))) |
| 3151 | message t)))) | 3151 | message t)))) |
| 3152 | 3152 | ||
| 3153 | (defun rcirc-check-auth-status (process sender args _text) | 3153 | (defun rcirc-check-auth-status (process sender args _text) |
| 3154 | "Check if the user just authenticated. | 3154 | "Check if the user just authenticated. |
| @@ -3200,10 +3200,10 @@ connection." | |||
| 3200 | (with-current-buffer (rcirc-get-buffer-create process channel) | 3200 | (with-current-buffer (rcirc-get-buffer-create process channel) |
| 3201 | ;; when recently rejoining, restore the linestamp | 3201 | ;; when recently rejoining, restore the linestamp |
| 3202 | (rcirc-put-nick-channel process sender channel | 3202 | (rcirc-put-nick-channel process sender channel |
| 3203 | (let ((last-activity-lines | 3203 | (let ((last-activity-lines |
| 3204 | (rcirc-elapsed-lines process sender channel))) | 3204 | (rcirc-elapsed-lines process sender channel))) |
| 3205 | (when (and last-activity-lines | 3205 | (when (and last-activity-lines |
| 3206 | (< last-activity-lines rcirc-omit-threshold)) | 3206 | (< last-activity-lines rcirc-omit-threshold)) |
| 3207 | (rcirc-last-line process sender channel)))) | 3207 | (rcirc-last-line process sender channel)))) |
| 3208 | ;; reset mode-line-process in case joining a channel with an | 3208 | ;; reset mode-line-process in case joining a channel with an |
| 3209 | ;; already open buffer (after getting kicked e.g.) | 3209 | ;; already open buffer (after getting kicked e.g.) |
| @@ -3223,25 +3223,25 @@ PROCESS is the process object for the current connection." | |||
| 3223 | (if (not (string= nick (rcirc-nick process))) | 3223 | (if (not (string= nick (rcirc-nick process))) |
| 3224 | ;; this is someone else leaving | 3224 | ;; this is someone else leaving |
| 3225 | (progn | 3225 | (progn |
| 3226 | (rcirc-maybe-remember-nick-quit process nick channel) | 3226 | (rcirc-maybe-remember-nick-quit process nick channel) |
| 3227 | (rcirc-remove-nick-channel process nick channel)) | 3227 | (rcirc-remove-nick-channel process nick channel)) |
| 3228 | ;; this is us leaving | 3228 | ;; this is us leaving |
| 3229 | (mapc (lambda (n) | 3229 | (mapc (lambda (n) |
| 3230 | (rcirc-remove-nick-channel process n channel)) | 3230 | (rcirc-remove-nick-channel process n channel)) |
| 3231 | (rcirc-channel-nicks process channel)) | 3231 | (rcirc-channel-nicks process channel)) |
| 3232 | 3232 | ||
| 3233 | ;; if the buffer is still around, make it inactive | 3233 | ;; if the buffer is still around, make it inactive |
| 3234 | (let ((buffer (rcirc-get-buffer process channel))) | 3234 | (let ((buffer (rcirc-get-buffer process channel))) |
| 3235 | (when buffer | 3235 | (when buffer |
| 3236 | (rcirc-disconnect-buffer buffer))))) | 3236 | (rcirc-disconnect-buffer buffer))))) |
| 3237 | 3237 | ||
| 3238 | (defun rcirc-handler-PART (process sender args _text) | 3238 | (defun rcirc-handler-PART (process sender args _text) |
| 3239 | "Handle PART message from SENDER. | 3239 | "Handle PART message from SENDER. |
| 3240 | ARGS should have the form (CHANNEL REASON). | 3240 | ARGS should have the form (CHANNEL REASON). |
| 3241 | PROCESS is the process object for the current connection." | 3241 | PROCESS is the process object for the current connection." |
| 3242 | (let* ((channel (car args)) | 3242 | (let* ((channel (car args)) |
| 3243 | (reason (cadr args)) | 3243 | (reason (cadr args)) |
| 3244 | (message (concat channel " " reason))) | 3244 | (message (concat channel " " reason))) |
| 3245 | (rcirc-print process sender "PART" (funcall rcirc-channel-filter channel) message) | 3245 | (rcirc-print process sender "PART" (funcall rcirc-channel-filter channel) message) |
| 3246 | ;; print in private chat buffer if it exists | 3246 | ;; print in private chat buffer if it exists |
| 3247 | (when (rcirc-get-buffer (rcirc-buffer-process) sender) | 3247 | (when (rcirc-get-buffer (rcirc-buffer-process) sender) |
| @@ -3254,9 +3254,9 @@ PROCESS is the process object for the current connection." | |||
| 3254 | ARGS should have the form (CHANNEL NICK REASON). | 3254 | ARGS should have the form (CHANNEL NICK REASON). |
| 3255 | PROCESS is the process object for the current connection." | 3255 | PROCESS is the process object for the current connection." |
| 3256 | (let* ((channel (car args)) | 3256 | (let* ((channel (car args)) |
| 3257 | (nick (cadr args)) | 3257 | (nick (cadr args)) |
| 3258 | (reason (nth 2 args)) | 3258 | (reason (nth 2 args)) |
| 3259 | (message (concat nick " " channel " " reason))) | 3259 | (message (concat nick " " channel " " reason))) |
| 3260 | (rcirc-print process sender "KICK" (funcall rcirc-channel-filter channel) message t) | 3260 | (rcirc-print process sender "KICK" (funcall rcirc-channel-filter channel) message t) |
| 3261 | ;; print in private chat buffer if it exists | 3261 | ;; print in private chat buffer if it exists |
| 3262 | (when (rcirc-get-buffer (rcirc-buffer-process) nick) | 3262 | (when (rcirc-get-buffer (rcirc-buffer-process) nick) |
| @@ -3269,28 +3269,28 @@ PROCESS is the process object for the current connection." | |||
| 3269 | PROCESS is the process object for the current connection." | 3269 | PROCESS is the process object for the current connection." |
| 3270 | (let ((elapsed-lines (rcirc-elapsed-lines process nick channel))) | 3270 | (let ((elapsed-lines (rcirc-elapsed-lines process nick channel))) |
| 3271 | (when (and elapsed-lines | 3271 | (when (and elapsed-lines |
| 3272 | (< elapsed-lines rcirc-omit-threshold)) | 3272 | (< elapsed-lines rcirc-omit-threshold)) |
| 3273 | (let ((buffer (rcirc-get-buffer process channel))) | 3273 | (let ((buffer (rcirc-get-buffer process channel))) |
| 3274 | (when buffer | 3274 | (when buffer |
| 3275 | (with-current-buffer buffer | 3275 | (with-current-buffer buffer |
| 3276 | (let ((record (assoc-string nick rcirc-recent-quit-alist t)) | 3276 | (let ((record (assoc-string nick rcirc-recent-quit-alist t)) |
| 3277 | (line (rcirc-last-line process nick channel))) | 3277 | (line (rcirc-last-line process nick channel))) |
| 3278 | (if record | 3278 | (if record |
| 3279 | (setcdr record line) | 3279 | (setcdr record line) |
| 3280 | (setq rcirc-recent-quit-alist | 3280 | (setq rcirc-recent-quit-alist |
| 3281 | (cons (cons nick line) | 3281 | (cons (cons nick line) |
| 3282 | rcirc-recent-quit-alist)))))))))) | 3282 | rcirc-recent-quit-alist)))))))))) |
| 3283 | 3283 | ||
| 3284 | (defun rcirc-handler-QUIT (process sender args _text) | 3284 | (defun rcirc-handler-QUIT (process sender args _text) |
| 3285 | "Handle QUIT message from SENDER. | 3285 | "Handle QUIT message from SENDER. |
| 3286 | PROCESS is the process object for the current connection." | 3286 | PROCESS is the process object for the current connection." |
| 3287 | (rcirc-ignore-update-automatic sender) | 3287 | (rcirc-ignore-update-automatic sender) |
| 3288 | (mapc (lambda (channel) | 3288 | (mapc (lambda (channel) |
| 3289 | ;; broadcast quit message each channel | 3289 | ;; broadcast quit message each channel |
| 3290 | (rcirc-print process sender "QUIT" (funcall rcirc-channel-filter channel) (apply 'concat args)) | 3290 | (rcirc-print process sender "QUIT" (funcall rcirc-channel-filter channel) (apply 'concat args)) |
| 3291 | ;; record nick in quit table if they recently spoke | 3291 | ;; record nick in quit table if they recently spoke |
| 3292 | (rcirc-maybe-remember-nick-quit process sender channel)) | 3292 | (rcirc-maybe-remember-nick-quit process sender channel)) |
| 3293 | (rcirc-nick-channels process sender)) | 3293 | (rcirc-nick-channels process sender)) |
| 3294 | (rcirc-nick-remove process sender)) | 3294 | (rcirc-nick-remove process sender)) |
| 3295 | 3295 | ||
| 3296 | (defun rcirc-handler-NICK (process sender args _text) | 3296 | (defun rcirc-handler-NICK (process sender args _text) |
| @@ -3311,9 +3311,9 @@ PROCESS is the process object for the current connection." | |||
| 3311 | ;; update chat buffer, if it exists | 3311 | ;; update chat buffer, if it exists |
| 3312 | (when-let ((chat-buffer (rcirc-get-buffer process old-nick))) | 3312 | (when-let ((chat-buffer (rcirc-get-buffer process old-nick))) |
| 3313 | (with-current-buffer chat-buffer | 3313 | (with-current-buffer chat-buffer |
| 3314 | (rcirc-print process sender "NICK" old-nick new-nick) | 3314 | (rcirc-print process sender "NICK" old-nick new-nick) |
| 3315 | (setq rcirc-target new-nick) | 3315 | (setq rcirc-target new-nick) |
| 3316 | (rename-buffer (rcirc-generate-new-buffer-name process new-nick) t)) | 3316 | (rename-buffer (rcirc-generate-new-buffer-name process new-nick) t)) |
| 3317 | (setf rcirc-buffer-alist | 3317 | (setf rcirc-buffer-alist |
| 3318 | (cons (cons new-nick chat-buffer) | 3318 | (cons (cons new-nick chat-buffer) |
| 3319 | (delq (assoc-string old-nick rcirc-buffer-alist t) | 3319 | (delq (assoc-string old-nick rcirc-buffer-alist t) |
| @@ -3326,7 +3326,7 @@ PROCESS is the process object for the current connection." | |||
| 3326 | ;; if this is our nick... | 3326 | ;; if this is our nick... |
| 3327 | (when (string= old-nick rcirc-nick) | 3327 | (when (string= old-nick rcirc-nick) |
| 3328 | (setq rcirc-nick new-nick) | 3328 | (setq rcirc-nick new-nick) |
| 3329 | (rcirc-update-prompt t) | 3329 | (rcirc-update-prompt t) |
| 3330 | ;; reauthenticate | 3330 | ;; reauthenticate |
| 3331 | (when rcirc-auto-authenticate-flag (rcirc-authenticate)))))) | 3331 | (when rcirc-auto-authenticate-flag (rcirc-authenticate)))))) |
| 3332 | 3332 | ||
| @@ -3356,16 +3356,16 @@ PROCESS is the process object for the current connection." | |||
| 3356 | ARGS should have the form (NICK AWAY-MESSAGE). | 3356 | ARGS should have the form (NICK AWAY-MESSAGE). |
| 3357 | PROCESS is the process object for the current connection." | 3357 | PROCESS is the process object for the current connection." |
| 3358 | (let* ((nick (cadr args)) | 3358 | (let* ((nick (cadr args)) |
| 3359 | (rec (assoc-string nick rcirc-nick-away-alist)) | 3359 | (rec (assoc-string nick rcirc-nick-away-alist)) |
| 3360 | (away-message (nth 2 args))) | 3360 | (away-message (nth 2 args))) |
| 3361 | (when (or (not rec) | 3361 | (when (or (not rec) |
| 3362 | (not (string= (cdr rec) away-message))) | 3362 | (not (string= (cdr rec) away-message))) |
| 3363 | ;; away message has changed | 3363 | ;; away message has changed |
| 3364 | (rcirc-handler-generic process "AWAY" nick (cdr args) text) | 3364 | (rcirc-handler-generic process "AWAY" nick (cdr args) text) |
| 3365 | (if rec | 3365 | (if rec |
| 3366 | (setcdr rec away-message) | 3366 | (setcdr rec away-message) |
| 3367 | (setq rcirc-nick-away-alist (cons (cons nick away-message) | 3367 | (setq rcirc-nick-away-alist (cons (cons nick away-message) |
| 3368 | rcirc-nick-away-alist)))))) | 3368 | rcirc-nick-away-alist)))))) |
| 3369 | 3369 | ||
| 3370 | (defun rcirc-handler-317 (process sender args _text) | 3370 | (defun rcirc-handler-317 (process sender args _text) |
| 3371 | "Handle idle messages from SENDER (RPL_WHOISIDLE). | 3371 | "Handle idle messages from SENDER (RPL_WHOISIDLE). |
| @@ -3374,7 +3374,7 @@ PROCESS is the process object for the current connection." | |||
| 3374 | (let* ((nick (nth 1 args)) | 3374 | (let* ((nick (nth 1 args)) |
| 3375 | (idle-secs (string-to-number (nth 2 args))) | 3375 | (idle-secs (string-to-number (nth 2 args))) |
| 3376 | (idle-string (format-seconds "%yy %dd %hh %mm %z%ss" idle-secs)) | 3376 | (idle-string (format-seconds "%yy %dd %hh %mm %z%ss" idle-secs)) |
| 3377 | (signon-time (string-to-number (nth 3 args))) | 3377 | (signon-time (string-to-number (nth 3 args))) |
| 3378 | (signon-string (format-time-string "%c" signon-time)) | 3378 | (signon-string (format-time-string "%c" signon-time)) |
| 3379 | (message (format "%s idle for %s, signed on %s" | 3379 | (message (format "%s idle for %s, signed on %s" |
| 3380 | nick idle-string signon-string))) | 3380 | nick idle-string signon-string))) |
| @@ -3385,7 +3385,7 @@ PROCESS is the process object for the current connection." | |||
| 3385 | ARGS should have the form (CHANNEL TOPIC). | 3385 | ARGS should have the form (CHANNEL TOPIC). |
| 3386 | PROCESS is the process object for the current connection." | 3386 | PROCESS is the process object for the current connection." |
| 3387 | (let ((buffer (or (rcirc-get-buffer process (cadr args)) | 3387 | (let ((buffer (or (rcirc-get-buffer process (cadr args)) |
| 3388 | (rcirc-get-temp-buffer-create process (cadr args))))) | 3388 | (rcirc-get-temp-buffer-create process (cadr args))))) |
| 3389 | (with-current-buffer buffer | 3389 | (with-current-buffer buffer |
| 3390 | (setq rcirc-topic (nth 2 args))))) | 3390 | (setq rcirc-topic (nth 2 args))))) |
| 3391 | 3391 | ||
| @@ -3396,13 +3396,13 @@ ARGS has the form (CHANNEL SETTER TIME). SENDER is passed on to | |||
| 3396 | connection. This is a non-standard extension, not specified in | 3396 | connection. This is a non-standard extension, not specified in |
| 3397 | RFC1459." | 3397 | RFC1459." |
| 3398 | (let ((buffer (or (rcirc-get-buffer process (cadr args)) | 3398 | (let ((buffer (or (rcirc-get-buffer process (cadr args)) |
| 3399 | (rcirc-get-temp-buffer-create process (cadr args))))) | 3399 | (rcirc-get-temp-buffer-create process (cadr args))))) |
| 3400 | (with-current-buffer buffer | 3400 | (with-current-buffer buffer |
| 3401 | (let ((setter (nth 2 args)) | 3401 | (let ((setter (nth 2 args)) |
| 3402 | (time (current-time-string | 3402 | (time (current-time-string |
| 3403 | (string-to-number (cadddr args))))) | 3403 | (string-to-number (cadddr args))))) |
| 3404 | (rcirc-print process sender "TOPIC" (cadr args) | 3404 | (rcirc-print process sender "TOPIC" (cadr args) |
| 3405 | (format "%s (%s on %s)" rcirc-topic setter time)))))) | 3405 | (format "%s (%s on %s)" rcirc-topic setter time)))))) |
| 3406 | 3406 | ||
| 3407 | (defun rcirc-handler-477 (process sender args _text) | 3407 | (defun rcirc-handler-477 (process sender args _text) |
| 3408 | "Notify user that CHANNEL does not support modes (ERR_NOCHANMODES). | 3408 | "Notify user that CHANNEL does not support modes (ERR_NOCHANMODES). |
| @@ -3426,9 +3426,9 @@ PROCESS is the process object for the current connection." | |||
| 3426 | 3426 | ||
| 3427 | ;; print in private chat buffers if they exist | 3427 | ;; print in private chat buffers if they exist |
| 3428 | (mapc (lambda (nick) | 3428 | (mapc (lambda (nick) |
| 3429 | (when (rcirc-get-buffer process nick) | 3429 | (when (rcirc-get-buffer process nick) |
| 3430 | (rcirc-print process sender "MODE" nick msg))) | 3430 | (rcirc-print process sender "MODE" nick msg))) |
| 3431 | (cddr args)))) | 3431 | (cddr args)))) |
| 3432 | 3432 | ||
| 3433 | (defun rcirc-get-temp-buffer-create (process channel) | 3433 | (defun rcirc-get-temp-buffer-create (process channel) |
| 3434 | "Return a buffer based on PROCESS and CHANNEL." | 3434 | "Return a buffer based on PROCESS and CHANNEL." |
| @@ -3440,7 +3440,7 @@ PROCESS is the process object for the current connection." | |||
| 3440 | ARGS should have the form (TYPE CHANNEL . NICK-LIST). | 3440 | ARGS should have the form (TYPE CHANNEL . NICK-LIST). |
| 3441 | PROCESS is the process object for the current connection." | 3441 | PROCESS is the process object for the current connection." |
| 3442 | (let ((channel (nth 2 args)) | 3442 | (let ((channel (nth 2 args)) |
| 3443 | (names (or (nth 3 args) ""))) | 3443 | (names (or (nth 3 args) ""))) |
| 3444 | (mapc (lambda (nick) | 3444 | (mapc (lambda (nick) |
| 3445 | (rcirc-put-nick-channel process nick channel)) | 3445 | (rcirc-put-nick-channel process nick channel)) |
| 3446 | (split-string names " " t)) | 3446 | (split-string names " " t)) |
| @@ -3459,7 +3459,7 @@ PROCESS is the process object for the current connection." | |||
| 3459 | (with-current-buffer buffer | 3459 | (with-current-buffer buffer |
| 3460 | (rcirc-print process sender "NAMES" channel | 3460 | (rcirc-print process sender "NAMES" channel |
| 3461 | (let ((content (buffer-substring (point-min) (point-max)))) | 3461 | (let ((content (buffer-substring (point-min) (point-max)))) |
| 3462 | (rcirc-sort-nicknames-join content " ")))) | 3462 | (rcirc-sort-nicknames-join content " ")))) |
| 3463 | (kill-buffer buffer))) | 3463 | (kill-buffer buffer))) |
| 3464 | 3464 | ||
| 3465 | (defun rcirc-handler-433 (process sender args text) | 3465 | (defun rcirc-handler-433 (process sender args text) |
| @@ -3507,11 +3507,11 @@ Passwords are stored in `rcirc-authinfo' (which see)." | |||
| 3507 | (with-rcirc-server-buffer | 3507 | (with-rcirc-server-buffer |
| 3508 | (dolist (i rcirc-authinfo) | 3508 | (dolist (i rcirc-authinfo) |
| 3509 | (let ((process (rcirc-buffer-process)) | 3509 | (let ((process (rcirc-buffer-process)) |
| 3510 | (server (car i)) | 3510 | (server (car i)) |
| 3511 | (nick (nth 2 i)) | 3511 | (nick (nth 2 i)) |
| 3512 | (method (cadr i)) | 3512 | (method (cadr i)) |
| 3513 | (args (cdddr i))) | 3513 | (args (cdddr i))) |
| 3514 | (when (and (string-match server rcirc-server)) | 3514 | (when (and (string-match server rcirc-server)) |
| 3515 | (if (and (memq method '(nickserv chanserv bitlbee)) | 3515 | (if (and (memq method '(nickserv chanserv bitlbee)) |
| 3516 | (string-match nick rcirc-nick)) | 3516 | (string-match nick rcirc-nick)) |
| 3517 | ;; the following methods rely on the user's nickname. | 3517 | ;; the following methods rely on the user's nickname. |
| @@ -3581,12 +3581,12 @@ current connection." | |||
| 3581 | (if (not (fboundp handler)) | 3581 | (if (not (fboundp handler)) |
| 3582 | (rcirc-print process sender "ERROR" target | 3582 | (rcirc-print process sender "ERROR" target |
| 3583 | (format "%s sent unsupported ctcp: %s" sender text) | 3583 | (format "%s sent unsupported ctcp: %s" sender text) |
| 3584 | t) | 3584 | t) |
| 3585 | (funcall handler process target sender args) | 3585 | (funcall handler process target sender args) |
| 3586 | (unless (or (string= request "ACTION") | 3586 | (unless (or (string= request "ACTION") |
| 3587 | (string= request "KEEPALIVE")) | 3587 | (string= request "KEEPALIVE")) |
| 3588 | (rcirc-print process sender "CTCP" target | 3588 | (rcirc-print process sender "CTCP" target |
| 3589 | (format "%s" text) t)))))) | 3589 | (format "%s" text) t)))))) |
| 3590 | 3590 | ||
| 3591 | (defun rcirc-handler-ctcp-VERSION (process _target sender _message) | 3591 | (defun rcirc-handler-ctcp-VERSION (process _target sender _message) |
| 3592 | "Handle a CTCP VERSION message from SENDER. | 3592 | "Handle a CTCP VERSION message from SENDER. |
| @@ -3733,7 +3733,7 @@ PROCESS is the process object for the current connection." | |||
| 3733 | '((t :family "Monospace")) | 3733 | '((t :family "Monospace")) |
| 3734 | "Face used for monospace text in messages.") | 3734 | "Face used for monospace text in messages.") |
| 3735 | 3735 | ||
| 3736 | (defface rcirc-my-nick ; font-lock-function-name-face | 3736 | (defface rcirc-my-nick ; font-lock-function-name-face |
| 3737 | '((((class color) (min-colors 88) (background light)) :foreground "Blue1") | 3737 | '((((class color) (min-colors 88) (background light)) :foreground "Blue1") |
| 3738 | (((class color) (min-colors 88) (background dark)) :foreground "LightSkyBlue") | 3738 | (((class color) (min-colors 88) (background dark)) :foreground "LightSkyBlue") |
| 3739 | (((class color) (min-colors 16) (background light)) :foreground "Blue") | 3739 | (((class color) (min-colors 16) (background light)) :foreground "Blue") |
| @@ -3742,7 +3742,7 @@ PROCESS is the process object for the current connection." | |||
| 3742 | (t :inverse-video t :weight bold)) | 3742 | (t :inverse-video t :weight bold)) |
| 3743 | "Rcirc face for my messages.") | 3743 | "Rcirc face for my messages.") |
| 3744 | 3744 | ||
| 3745 | (defface rcirc-other-nick ; font-lock-variable-name-face | 3745 | (defface rcirc-other-nick ; font-lock-variable-name-face |
| 3746 | '((((class grayscale) (background light)) | 3746 | '((((class grayscale) (background light)) |
| 3747 | :foreground "Gray90" :weight bold :slant italic) | 3747 | :foreground "Gray90" :weight bold :slant italic) |
| 3748 | (((class grayscale) (background dark)) | 3748 | (((class grayscale) (background dark)) |
| @@ -3772,7 +3772,7 @@ PROCESS is the process object for the current connection." | |||
| 3772 | '((t :inherit default)) | 3772 | '((t :inherit default)) |
| 3773 | "Rcirc face for nicks in `rcirc-dim-nicks'.") | 3773 | "Rcirc face for nicks in `rcirc-dim-nicks'.") |
| 3774 | 3774 | ||
| 3775 | (defface rcirc-server ; font-lock-comment-face | 3775 | (defface rcirc-server ; font-lock-comment-face |
| 3776 | '((((class grayscale) (background light)) | 3776 | '((((class grayscale) (background light)) |
| 3777 | :foreground "DimGray" :weight bold :slant italic) | 3777 | :foreground "DimGray" :weight bold :slant italic) |
| 3778 | (((class grayscale) (background dark)) | 3778 | (((class grayscale) (background dark)) |
| @@ -3790,7 +3790,7 @@ PROCESS is the process object for the current connection." | |||
| 3790 | (t :weight bold :slant italic)) | 3790 | (t :weight bold :slant italic)) |
| 3791 | "Rcirc face for server messages.") | 3791 | "Rcirc face for server messages.") |
| 3792 | 3792 | ||
| 3793 | (defface rcirc-server-prefix ; font-lock-comment-delimiter-face | 3793 | (defface rcirc-server-prefix ; font-lock-comment-delimiter-face |
| 3794 | '((default :inherit rcirc-server) | 3794 | '((default :inherit rcirc-server) |
| 3795 | (((class grayscale))) | 3795 | (((class grayscale))) |
| 3796 | (((class color) (min-colors 16))) | 3796 | (((class color) (min-colors 16))) |
| @@ -3804,7 +3804,7 @@ PROCESS is the process object for the current connection." | |||
| 3804 | '((t :inherit default)) | 3804 | '((t :inherit default)) |
| 3805 | "Rcirc face for timestamps.") | 3805 | "Rcirc face for timestamps.") |
| 3806 | 3806 | ||
| 3807 | (defface rcirc-nick-in-message ; font-lock-keyword-face | 3807 | (defface rcirc-nick-in-message ; font-lock-keyword-face |
| 3808 | '((((class grayscale) (background light)) :foreground "LightGray" :weight bold) | 3808 | '((((class grayscale) (background light)) :foreground "LightGray" :weight bold) |
| 3809 | (((class grayscale) (background dark)) :foreground "DimGray" :weight bold) | 3809 | (((class grayscale) (background dark)) :foreground "DimGray" :weight bold) |
| 3810 | (((class color) (min-colors 88) (background light)) :foreground "Purple") | 3810 | (((class color) (min-colors 88) (background light)) :foreground "Purple") |
| @@ -3818,7 +3818,7 @@ PROCESS is the process object for the current connection." | |||
| 3818 | (defface rcirc-nick-in-message-full-line '((t :weight bold)) | 3818 | (defface rcirc-nick-in-message-full-line '((t :weight bold)) |
| 3819 | "Rcirc face for emphasizing the entire message when your nick is mentioned.") | 3819 | "Rcirc face for emphasizing the entire message when your nick is mentioned.") |
| 3820 | 3820 | ||
| 3821 | (defface rcirc-prompt ; comint-highlight-prompt | 3821 | (defface rcirc-prompt ; comint-highlight-prompt |
| 3822 | '((((min-colors 88) (background dark)) :foreground "cyan1") | 3822 | '((((min-colors 88) (background dark)) :foreground "cyan1") |
| 3823 | (((background dark)) :foreground "cyan") | 3823 | (((background dark)) :foreground "cyan") |
| 3824 | (t :foreground "dark blue")) | 3824 | (t :foreground "dark blue")) |