lirc.el

   1 ;;; lirc.el --- Lambdalabs irc client  -*- lexical-binding:t -*-
   2
   3 ;; Copyright (C) 2021 Tim Vaughan
   4
   5 ;; Author: Tim Vaughan <timv@ughan.xyz>
   6 ;; Created: 14 June 2021
   7 ;; Version: 1.0
   8 ;; Keywords: network
   9 ;; Homepage: http://thelambdalab.xyz/erc
  10 ;; Package-Requires: ((emacs "26"))
  11
  12 ;; This file is not part of GNU Emacs.
  13
  14 ;; This program is free software: you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation, either version 3 of the License, or
  17 ;; (at your option) any later version.
  18
  19 ;; This program is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with this file.  If not, see <http://www.gnu.org/licenses/>.
  26
  27 ;;; Commentary:
  28
  29 ;;; Code:
  30
  31 (provide 'lerc)
  32
  33 ;;; Customizations
  34 ;;
  35
  36 (defgroup lirc nil
  37   "Lightweight IRC client."
  38   :group 'network)
  39
  40 (defcustom lirc-nick "plugd"
  41   "Default nick.")
  42 (defcustom lirc-full-name "plugd"
  43   "Default full name.")
  44 (defcustom lirc-user-name "plugd"
  45   "Default user name.")
  46 (defcustom lirc-host "localhost"
  47   "Default server.")
  48 (defcustom lirc-port 6667
  49   "Default port.")
  50
  51 (defcustom lirc-prompt "> "
  52   "Prompt.")
  53
  54 (defvar lirc-response "")
  55
  56 (defun lirc-filter (proc string)
  57   (dolist (line (split-string (concat lirc-response string) "\n"))
  58     (if (string-suffix-p "\r" line)
  59         (lirc-process-msg-string (string-trim line))
  60       (setq lirc-response line))))
  61
  62 (defun lirc-get-process ()
  63   (let ((proc (get-process "lirc")))
  64     (if (and proc (eq (process-status proc) 'open))
  65         proc
  66       (make-network-process :name "lirc"
  67                             :host lirc-host
  68                             :service lirc-port
  69                             :filter #'lirc-filter
  70                             :nowait t
  71                             :buffer "*lirc*"))))
  72
  73 (defun lirc-as-string (obj)
  74   (if obj
  75       (with-output-to-string (princ obj))
  76     nil))
  77
  78 (defun lirc-msg (tags src cmd &rest params)
  79   (list (lirc-as-string tags)
  80         (lirc-as-string src)
  81         (upcase (lirc-as-string cmd))
  82         (mapcar #'lirc-as-string params)))
  83
  84 (defun lirc-msg-tags (msg) (elt msg 0))
  85 (defun lirc-msg-src (msg) (elt msg 1))
  86 (defun lirc-msg-cmd (msg) (elt msg 2))
  87 (defun lirc-msg-params (msg) (elt msg 3))
  88
  89 (defvar lirc-msg-regex
  90   (rx
  91    (opt (: "@" (group (* (not (or "\n" "\r" ";" " ")))))
  92         (* whitespace))
  93    (opt (: ":" (group (* (not (or "\n" "\r" " ")))))
  94         (* whitespace))
  95    (group (: (* (not whitespace))))
  96    (* whitespace)
  97    (opt (group (+ not-newline)))))
  98
  99 (defun lirc-string->msg (string)
 100   (if (string-match lirc-msg-regex string)
 101       (let* ((tags (match-string 1 string))
 102              (src (match-string 2 string))
 103              (cmd (upcase (match-string 3 string)))
 104              (params-str (match-string 4 string))
 105              (params
 106               (if params-str
 107                   (let* ((idx (cl-search ":" params-str))
 108                          (l (split-string (string-trim (substring params-str 0 idx))))
 109                          (r (if idx (list (substring params-str (+ 1 idx))) nil)))
 110                     (append l r))
 111                 nil)))
 112         (apply #'lirc-msg (append (list tags src cmd) params)))
 113     (error "Failed to parse string " string)))
 114
 115 (defun lirc-msg->string (msg)
 116   (let ((tags (lirc-msg-tags msg))
 117         (src (lirc-msg-src msg))
 118         (cmd (lirc-msg-cmd msg))
 119         (params (lirc-msg-params msg)))
 120     (concat
 121      (if tags (concat "@" tags " ") "")
 122      (if src (concat ":" src " ") "")
 123      cmd " "
 124      (if (> (length params) 1)
 125          (string-join (seq-take params (- (length params) 1)) " ")
 126        "")
 127      (if (> (length params) 0)
 128          (concat " :" (elt params (- (length params) 1)))))))
 129
 130 (defun lirc-display-string (string)
 131   (with-current-buffer "*lirc*"
 132     (let ((inhibit-read-only t))
 133       (save-excursion
 134         (goto-char (point-max))
 135         (insert string "\n")))))
 136
 137 (defun lirc-process-msg-string (string)
 138   (let ((msg (lirc-string->msg string)))
 139     (cond
 140      ((equal (lirc-msg-cmd msg) "PING")
 141       (lirc-send-msg
 142        (lirc-msg nil nil "PONG" (lirc-msg-params msg))))
 143      (t
 144       (lirc-display-string (lirc-msg->string msg))))))
 145
 146 (defun lirc-connect ()
 147   (lirc-send-msg (lirc-msg nil nil "USER" lirc-user-name 0 "*" lirc-full-name))
 148   (lirc-send-msg (lirc-msg nil nil "NICK" lirc-nick)))
 149
 150 (defun lirc-send-msg (msg)
 151   (let ((proc (lirc-get-process)))
 152     (process-send-string proc (concat (lirc-msg->string msg) "\r\n"))))
 153
 154
 155 (defun lirc ()
 156   "Switch to *lirc* buffer."
 157   (interactive)
 158   (pop-to-buffer-same-window "*lirc*")
 159   (lirc-mode)
 160   (lirc-connect))
 161
 162 (define-derived-mode lirc-mode text-mode "lirc"
 163   "Major mode for LIRC.")
 164
 165
 166 ;;; lirc.el ends here
 167 :bs-mbpr348.d.ethz.ch