From: Tim Vaughan 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 +;; 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 . + +;;; 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