The Lambda Lab
/
projects
/
lurk.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
b37326a
)
Now using TLS, improved handling of joins/quits.
author
Tim Vaughan
<plugd@thelambdalab.xyz>
Mon, 21 Jun 2021 08:50:45 +0000
(10:50 +0200)
committer
Tim Vaughan
<plugd@thelambdalab.xyz>
Mon, 21 Jun 2021 08:50:45 +0000
(10:50 +0200)
lirc.el
patch
|
blob
|
history
diff --git
a/lirc.el
b/lirc.el
index
e6f47fb
..
9b64811
100644
(file)
--- a/
lirc.el
+++ b/
lirc.el
@@
-43,9
+43,9
@@
"Default full name.")
(defcustom lirc-user-name "plugd"
"Default user name.")
"Default full name.")
(defcustom lirc-user-name "plugd"
"Default user name.")
-(defcustom lirc-host "
localhos
t"
+(defcustom lirc-host "
irc.libera.cha
t"
"Default server.")
"Default server.")
-(defcustom lirc-port 66
6
7
+(defcustom lirc-port 66
9
7
"Default port.")
(defcustom lirc-prompt-string "> "
"Default port.")
(defcustom lirc-prompt-string "> "
@@
-70,11
+70,28
@@
'((t :inherit org-list-dt))
"Face used for the channel name in the prompt.")
'((t :inherit org-list-dt))
"Face used for the channel name in the prompt.")
+(defface lirc-faded
+ '((t :inherit font-lock-preprocessor-face))
+ "Face used for Lirc text.")
+
+(defface lirc-bold
+ '((t :inherit font-lock-function-name-face))
+ "Face used for Lirc text.")
+
;;; Global variables
;;
(defvar lirc-version "Lirc v0.1")
;;; Global variables
;;
(defvar lirc-version "Lirc v0.1")
+(defvar lirc-notice-prompt
+ (concat
+ (propertize
+ "-" 'face 'lirc-faded)
+ (propertize
+ "!" 'face 'lirc-bold)
+ (propertize
+ "-" 'face 'lirc-faded)))
+
;;; Network process
;;
;;; Network process
;;
@@
-95,7
+112,11
@@
:host lirc-host
:service lirc-port
:filter #'lirc-filter
:host lirc-host
:service lirc-port
:filter #'lirc-filter
- :nowait t
+ :nowait nil
+ :tls-parameters (cons 'gnutls-x509pki
+ (gnutls-boot-parameters
+ :type 'gnutls-x509pki
+ :hostname lirc-host))
:buffer "*lirc*"))))
;;; Messages
:buffer "*lirc*"))))
;;; Messages
@@
-203,6
+224,18
@@
portion of the source component of the message, as LIRC doesn't use this.")
(lirc-set-channel-users channel-name
(cl-set-difference current-users users :test #'equal))))
(lirc-set-channel-users channel-name
(cl-set-difference current-users users :test #'equal))))
+(defun lirc-del-users (&rest users)
+ (dolist (channel lirc-channel-list)
+ (apply #'lirc-del-channel-users (cons (car channel) users))))
+
+(defun lirc-rename-user (old-nick new-nick)
+ (dolist (channel lirc-channel-list)
+ (let ((channel-name (car channel))
+ (channel-users (cdr channel)))
+ (when (memq old-nick channel-users)
+ (lirc-del-channel-users old-nick)
+ (lirc-add-channel-users new-nick)))))
+
;;; Buffer
;;
;;; Buffer
;;
@@
-287,7
+320,7
@@
portion of the source component of the message, as LIRC doesn't use this.")
(propertize message 'face 'lirc-text))))
(defun lirc-display-notice (&rest notices)
(propertize message 'face 'lirc-text))))
(defun lirc-display-notice (&rest notices)
- (lirc-display-string
"***
" (apply #'concat notices)))
+ (lirc-display-string
lirc-notice-prompt "
" (apply #'concat notices)))
;;; Message evaluation
;;
;;; Message evaluation
;;
@@
-306,6
+339,11
@@
portion of the source component of the message, as LIRC doesn't use this.")
(names (split-string (elt params 3))))
(apply #'lirc-add-channel-users (cons channel names))))
(names (split-string (elt params 3))))
(apply #'lirc-add-channel-users (cons channel names))))
+ ("366" ; ENDOFNAMES
+ (lirc-display-notice
+ (lirc-as-string (length (lirc-get-channel-users lirc-current-channel)))
+ " users in " lirc-current-channel))
+
((rx (= 3 (any digit)))
(lirc-display-notice (mapconcat 'identity (cdr (lirc-msg-params msg)) " ")))
((rx (= 3 (any digit)))
(lirc-display-notice (mapconcat 'identity (cdr (lirc-msg-params msg)) " ")))
@@
-319,7
+357,8
@@
portion of the source component of the message, as LIRC doesn't use this.")
("JOIN"
(let ((channel (car (lirc-msg-params msg)))
(nick (lirc-msg-src msg)))
("JOIN"
(let ((channel (car (lirc-msg-params msg)))
(nick (lirc-msg-src msg)))
- (lirc-add-channel-users channel nick)))
+ (lirc-add-channel-users channel nick)
+ (lirc-display-notice nick " joined channel " channel)))
((and "PART"
(guard (equal lirc-nick (lirc-msg-src msg))))
((and "PART"
(guard (equal lirc-nick (lirc-msg-src msg))))
@@
-344,6
+383,12
@@
portion of the source component of the message, as LIRC doesn't use this.")
(setq lirc-nick (car (lirc-msg-params msg)))
(lirc-display-notice "Set nick to " lirc-nick))
(setq lirc-nick (car (lirc-msg-params msg)))
(lirc-display-notice "Set nick to " lirc-nick))
+ ("NICK"
+ (let ((old-nick (lirc-msg-src msg))
+ (new-nick (car (lirc-msg-params msg))))
+ (lirc-display-notice nick " is now known as " new-nick)
+ (lirc-rename-user nick new-nick)))
+
("NOTICE"
(let ((nick (lirc-msg-src msg))
(channel (car (lirc-msg-params msg)))
("NOTICE"
(let ((nick (lirc-msg-src msg))
(channel (car (lirc-msg-params msg)))
@@
-352,7
+397,9
@@
portion of the source component of the message, as LIRC doesn't use this.")
((rx (: "\01VERSION "
(let version (* (not "\01")))
"\01"))
((rx (: "\01VERSION "
(let version (* (not "\01")))
"\01"))
- (lirc-display-notice "CTCP version reply from " nick ": " version)))))
+ (lirc-display-notice "CTCP version reply from " nick ": " version))
+ (_
+ (lirc-display-notice text)))))
("PRIVMSG"
(let ((nick (lirc-msg-src msg))
("PRIVMSG"
(let ((nick (lirc-msg-src msg))
@@
-408,6
+455,13
@@
portion of the source component of the message, as LIRC doesn't use this.")
((rx "PART")
(lirc-send-msg (lirc-msg nil nil "PART" lirc-current-channel)))
((rx "PART")
(lirc-send-msg (lirc-msg nil nil "PART" lirc-current-channel)))
+ ((rx "MSG "
+ (let target (* (not whitespace)))
+ " "
+ (let text (* not-newline)))
+ (lirc-send-msg (lirc-msg nil nil "PRIVMSG" target text))
+ (lirc-display-message target lirc-nick text))
+
((rx (: (let cmd-str (+ (not whitespace)))
(opt (: " " (let params-str (* not-newline))))))
(lirc-send-msg (lirc-msg nil nil (upcase cmd-str)
((rx (: (let cmd-str (+ (not whitespace)))
(opt (: " " (let params-str (* not-newline))))))
(lirc-send-msg (lirc-msg nil nil (upcase cmd-str)