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 ;;; Faces
  55 ;;
  56
  57 ;;; Global variables
  58 ;;
  59
  60 (defvar lirc-current-channel nil)
  61 (defvar lirc-channel-list nil)
  62
  63 (defvar lirc-response "")
  64
  65 (defun lirc-filter (proc string)
  66   (dolist (line (split-string (concat lirc-response string) "\n"))
  67     (if (string-suffix-p "\r" line)
  68         (lirc-process-msg-string (string-trim line))
  69       (setq lirc-response line))))
  70
  71 (defun lirc-get-process ()
  72   (let ((proc (get-process "lirc")))
  73     (if (and proc (eq (process-status proc) 'open))
  74         proc
  75       (make-network-process :name "lirc"
  76                             :host lirc-host
  77                             :service lirc-port
  78                             :filter #'lirc-filter
  79                             :nowait t
  80                             :buffer "*lirc*"))))
  81
  82 (defun lirc-as-string (obj)
  83   (if obj
  84       (with-output-to-string (princ obj))
  85     nil))
  86
  87 (defun lirc-msg (tags src cmd &rest params)
  88   (list (lirc-as-string tags)
  89         (lirc-as-string src)
  90         (upcase (lirc-as-string cmd))
  91         (mapcar #'lirc-as-string
  92                 (if (and params (listp (elt params 0)))
  93                     (elt params 0)
  94                   params))))
  95
  96 (defun lirc-msg-tags (msg) (elt msg 0))
  97 (defun lirc-msg-src (msg) (elt msg 1))
  98 (defun lirc-msg-cmd (msg) (elt msg 2))
  99 (defun lirc-msg-params (msg) (elt msg 3))
 100 (defun lirc-msg-trail (msg)
 101   (let ((params (lirc-msg-params msg)))
 102     (if params
 103         (elt params (- (length params) 1)))))
 104
 105 (defvar lirc-msg-regex
 106   (rx
 107    (opt (: "@" (group (* (not (or "\n" "\r" ";" " ")))))
 108         (* whitespace))
 109    (opt (: ":" (group (* (not (or "\n" "\r" " ")))))
 110         (* whitespace))
 111    (group (: (* (not whitespace))))
 112    (* whitespace)
 113    (opt (group (+ not-newline)))))
 114
 115 (defun lirc-string->msg (string)
 116   (if (string-match lirc-msg-regex string)
 117       (let* ((tags (match-string 1 string))
 118              (src (match-string 2 string))
 119              (cmd (upcase (match-string 3 string)))
 120              (params-str (match-string 4 string))
 121              (params
 122               (if params-str
 123                   (let* ((idx (cl-search ":" params-str))
 124                          (l (split-string (string-trim (substring params-str 0 idx))))
 125                          (r (if idx (list (substring params-str (+ 1 idx))) nil)))
 126                     (append l r))
 127                 nil)))
 128         (apply #'lirc-msg (append (list tags src cmd) params)))
 129     (error "Failed to parse string " string)))
 130
 131 (defun lirc--filtered-join (&rest args)
 132   (string-join (seq-filter (lambda (el) el) args) " "))
 133
 134 (defun lirc-msg->string (msg)
 135   (let ((tags (lirc-msg-tags msg))
 136         (src (lirc-msg-src msg))
 137         (cmd (lirc-msg-cmd msg))
 138         (params (lirc-msg-params msg)))
 139     (lirc--filtered-join
 140      (if tags (concat "@" tags) nil)
 141      (if src (concat ":" src) nil)
 142      cmd
 143      (if (> (length params) 1)
 144          (string-join (seq-take params (- (length params) 1)) " ")
 145        nil)
 146      (if (> (length params) 0)
 147          (concat ":" (elt params (- (length params) 1)))
 148        nil))))
 149
 150 (defun lirc-display-string (string)
 151   (with-current-buffer "*lirc*"
 152     (let ((inhibit-read-only t))
 153       (save-excursion
 154         (goto-char (point-max))
 155         (insert (propertize (concat string "\n") 'read-only t))))))
 156
 157 (defun lirc-process-msg-string (string)
 158   (let* ((msg (lirc-string->msg string)))
 159     (cond
 160      ((equal (lirc-msg-cmd msg) "PING")
 161       (lirc-send-msg
 162        (lirc-msg nil nil "PONG" (lirc-msg-params msg))))
 163      ((string-match (rx (= 3 digit)) (lirc-msg-cmd msg))
 164       (lirc-display-string (string-join (cdr (lirc-msg-params msg)) " ")))
 165      (t
 166       (lirc-display-string (lirc-msg->string msg))))))
 167
 168 (defun lirc-connect ()
 169   (lirc-send-msg (lirc-msg nil nil "USER" lirc-user-name 0 "*" lirc-full-name))
 170   (lirc-send-msg (lirc-msg nil nil "NICK" lirc-nick)))
 171
 172 (defun lirc-send-msg (msg)
 173   (let ((proc (lirc-get-process)))
 174     (process-send-string proc (concat (lirc-msg->string msg) "\r\n"))))
 175
 176
 177 (defun lirc ()
 178   "Switch to *lirc* buffer."
 179   (interactive)
 180   (pop-to-buffer-same-window "*lirc*")
 181   (lirc-mode)
 182   (lirc-connect))
 183
 184 (define-derived-mode lirc-mode text-mode "lirc"
 185   "Major mode for LIRC.")
 186
 187
 188 ;;; lirc.el ends here
 189 :bs-mbpr348.d.ethz.ch