From: Tim Vaughan <plugd@thelambdalab.xyz>
Date: Tue, 15 Jun 2021 14:41:49 +0000 (+0200)
Subject: Initial commit.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=9d8a20ea72ce8b050b69a33a7461e4a94db7691a;p=lurk.git

Initial commit.
---

9d8a20ea72ce8b050b69a33a7461e4a94db7691a
diff --git a/lirc.el b/lirc.el
new file mode 100644
index 0000000..c9dc91b
--- /dev/null
+++ b/lirc.el
@@ -0,0 +1,167 @@
+;;; lirc.el --- Lambdalabs irc client  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021 Tim Vaughan
+
+;; Author: Tim Vaughan <timv@ughan.xyz>
+;; Created: 14 June 2021
+;; Version: 1.0
+;; Keywords: network
+;; Homepage: http://thelambdalab.xyz/erc
+;; Package-Requires: ((emacs "26"))
+
+;; This file is not part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this file.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(provide 'lerc)
+
+;;; Customizations
+;;
+
+(defgroup lirc nil
+  "Lightweight IRC client."
+  :group 'network)
+
+(defcustom lirc-nick "plugd"
+  "Default nick.")
+(defcustom lirc-full-name "plugd"
+  "Default full name.")
+(defcustom lirc-user-name "plugd"
+  "Default user name.")
+(defcustom lirc-host "localhost"
+  "Default server.")
+(defcustom lirc-port 6667
+  "Default port.")
+
+(defcustom lirc-prompt "> "
+  "Prompt.")
+
+(defvar lirc-response "")
+
+(defun lirc-filter (proc string)
+  (dolist (line (split-string (concat lirc-response string) "\n"))
+    (if (string-suffix-p "\r" line)
+        (lirc-process-msg-string (string-trim line))
+      (setq lirc-response line))))
+
+(defun lirc-get-process ()
+  (let ((proc (get-process "lirc")))
+    (if (and proc (eq (process-status proc) 'open))
+        proc
+      (make-network-process :name "lirc"
+                            :host lirc-host
+                            :service lirc-port
+                            :filter #'lirc-filter
+                            :nowait t
+                            :buffer "*lirc*"))))
+
+(defun lirc-as-string (obj)
+  (if obj
+      (with-output-to-string (princ obj))
+    nil))
+
+(defun lirc-msg (tags src cmd &rest params)
+  (list (lirc-as-string tags)
+        (lirc-as-string src)
+        (upcase (lirc-as-string cmd))
+        (mapcar #'lirc-as-string params)))
+
+(defun lirc-msg-tags (msg) (elt msg 0))
+(defun lirc-msg-src (msg) (elt msg 1))
+(defun lirc-msg-cmd (msg) (elt msg 2))
+(defun lirc-msg-params (msg) (elt msg 3))
+
+(defvar lirc-msg-regex
+  (rx
+   (opt (: "@" (group (* (not (or "\n" "\r" ";" " ")))))
+        (* whitespace))
+   (opt (: ":" (group (* (not (or "\n" "\r" " ")))))
+        (* whitespace))
+   (group (: (* (not whitespace))))
+   (* whitespace)
+   (opt (group (+ not-newline)))))
+
+(defun lirc-string->msg (string)
+  (if (string-match lirc-msg-regex string)
+      (let* ((tags (match-string 1 string))
+             (src (match-string 2 string))
+             (cmd (upcase (match-string 3 string)))
+             (params-str (match-string 4 string))
+             (params
+              (if params-str
+                  (let* ((idx (cl-search ":" params-str))
+                         (l (split-string (string-trim (substring params-str 0 idx))))
+                         (r (if idx (list (substring params-str (+ 1 idx))) nil)))
+                    (append l r))
+                nil)))
+        (apply #'lirc-msg (append (list tags src cmd) params)))
+    (error "Failed to parse string " string)))
+
+(defun lirc-msg->string (msg)
+  (let ((tags (lirc-msg-tags msg))
+        (src (lirc-msg-src msg))
+        (cmd (lirc-msg-cmd msg))
+        (params (lirc-msg-params msg)))
+    (concat
+     (if tags (concat "@" tags " ") "")
+     (if src (concat ":" src " ") "")
+     cmd " "
+     (if (> (length params) 1)
+         (string-join (seq-take params (- (length params) 1)) " ")
+       "")
+     (if (> (length params) 0)
+         (concat " :" (elt params (- (length params) 1)))))))
+
+(defun lirc-display-string (string)
+  (with-current-buffer "*lirc*"
+    (let ((inhibit-read-only t))
+      (save-excursion
+        (goto-char (point-max))
+        (insert string "\n")))))
+
+(defun lirc-process-msg-string (string)
+  (let ((msg (lirc-string->msg string)))
+    (cond
+     ((equal (lirc-msg-cmd msg) "PING")
+      (lirc-send-msg
+       (lirc-msg nil nil "PONG" (lirc-msg-params msg))))
+     (t
+      (lirc-display-string (lirc-msg->string msg))))))
+
+(defun lirc-connect ()
+  (lirc-send-msg (lirc-msg nil nil "USER" lirc-user-name 0 "*" lirc-full-name))
+  (lirc-send-msg (lirc-msg nil nil "NICK" lirc-nick)))
+
+(defun lirc-send-msg (msg)
+  (let ((proc (lirc-get-process)))
+    (process-send-string proc (concat (lirc-msg->string msg) "\r\n"))))
+  
+
+(defun lirc ()
+  "Switch to *lirc* buffer."
+  (interactive)
+  (pop-to-buffer-same-window "*lirc*")
+  (lirc-mode)
+  (lirc-connect))
+
+(define-derived-mode lirc-mode text-mode "lirc"
+  "Major mode for LIRC.")
+
+
+;;; lirc.el ends here
+:bs-mbpr348.d.ethz.ch