From a8753ebe5492cf0bc66e7b18e128c7d87936f551 Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Tue, 15 Jun 2021 22:47:49 +0200 Subject: [PATCH] Read-only behaviour is now correct. --- lirc.el | 103 ++++++++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 85 insertions(+), 18 deletions(-) diff --git a/lirc.el b/lirc.el index db78af8..ee6bdd4 100644 --- a/lirc.el +++ b/lirc.el @@ -48,12 +48,16 @@ (defcustom lirc-port 6667 "Default port.") -(defcustom lirc-prompt "> " +(defcustom lirc-prompt-string "prompt> " "Prompt.") ;;; Faces ;; +(defface lirc-prompt + '((t :inherit font-lock-string-face)) + "Face used for the prompt.") + ;;; Global variables ;; @@ -62,10 +66,14 @@ (defvar lirc-response "") + +;;; Network process +;; + (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)) + (lirc-eval-msg-string (string-trim line)) (setq lirc-response line)))) (defun lirc-get-process () @@ -79,6 +87,9 @@ :nowait t :buffer "*lirc*")))) +;;; Messages +;; + (defun lirc-as-string (obj) (if obj (with-output-to-string (princ obj)) @@ -147,14 +158,61 @@ (concat ":" (elt params (- (length params) 1))) nil)))) + +;;; Buffer +;; + (defun lirc-display-string (string) + (with-current-buffer (get-buffer-create "*lirc*") + (save-excursion + (goto-char lirc-prompt-marker) + (let ((inhibit-read-only t)) + (insert-before-markers (propertize (concat string "\n") 'read-only t)))))) + +(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-render-prompt () (with-current-buffer "*lirc*" + (set-marker-insertion-type lirc-prompt-marker nil) + (set-marker-insertion-type lirc-input-marker t) (let ((inhibit-read-only t)) - (save-excursion - (goto-char (point-max)) - (insert (propertize (concat string "\n") 'read-only t)))))) + (delete-region lirc-prompt-marker lirc-input-marker)) + (save-excursion + (goto-char lirc-prompt-marker) + (let ((inhibit-read-only t)) + (insert (propertize lirc-prompt-string + 'face 'lirc-prompt + 'read-only t + 'rear-nonsticky t)))))) + +(defvar lirc-prompt-marker nil + "Marker for prompt position in LIRC buffer.") + +(defvar lirc-input-marker nil + "Marker for prompt position in LIRC buffer.") + +(defun lirc-setup-buffer () + (with-current-buffer (get-buffer-create "*lirc*") + (if (markerp lirc-prompt-marker) + (set-marker lirc-prompt-marker (point-max)) + (setq lirc-prompt-marker (point-max-marker))) + (if (markerp lirc-input-marker) + (set-marker lirc-input-marker (point-max)) + (setq lirc-input-marker (point-max-marker))) + (lirc-render-prompt) + (goto-char (point-max)) + (recenter -1))) + +;;; Message evaluation +;; -(defun lirc-process-msg-string (string) +(defun lirc-eval-msg-string (string) (let* ((msg (lirc-string->msg string))) (cond ((equal (lirc-msg-cmd msg) "PING") @@ -165,25 +223,34 @@ (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")))) - +;;; Mode +;; + +(defvar lirc-mode-map + (let ((map (make-sparse-keymap))) + map)) + +(define-derived-mode lirc-mode text-mode "lirc" + "Major mode for LIRC.") + +(when (fboundp 'evil-set-initial-state) + (evil-set-initial-state 'lirc-mode 'insert)) + +;;; Main start procedure +;; (defun lirc () "Switch to *lirc* buffer." (interactive) - (pop-to-buffer-same-window "*lirc*") + (if (get-buffer "*lirc*") + (switch-to-buffer "*lirc*") + (switch-to-buffer "*lirc*")) (lirc-mode) - (lirc-connect)) + (lirc-setup-buffer) + (lirc-connect) + "Started LIRC.") -(define-derived-mode lirc-mode text-mode "lirc" - "Major mode for LIRC.") ;;; lirc.el ends here -:bs-mbpr348.d.ethz.ch -- 2.20.1