Cleaner connection code.

diff --git a/lirc.el b/lirc.el
index 9b64811..0767a46 100644 (file)
--- a/lirc.el
+++ b/lirc.el
@@ -72,11 +72,15 @@
 
 (defface lirc-faded
   '((t :inherit font-lock-preprocessor-face))
 
 (defface lirc-faded
   '((t :inherit font-lock-preprocessor-face))

-  "Face used for Lirc text.")
+  "Face used for faded Lirc text.")

 
 (defface lirc-bold
   '((t :inherit font-lock-function-name-face))
 
 (defface lirc-bold
   '((t :inherit font-lock-function-name-face))

-  "Face used for Lirc text.")
+  "Face used for bold Lirc text.")
+
+(defface lirc-error
+  '((t :inherit font-lock-regexp-grouping-construct))
+  "Face used for Lirc error text.")

 
 ;;; Global variables
 ;;
 
 ;;; Global variables
 ;;


@@ -91,7 +95,10 @@
     "!" 'face 'lirc-bold)
    (propertize
     "-" 'face 'lirc-faded)))
     "!" 'face 'lirc-bold)
    (propertize
     "-" 'face 'lirc-faded)))

-   
+
+(defvar lirc-error-prompt
+  (propertize "!!!" 'face 'lirc-error))
+

 
 ;;; Network process
 ;;
 
 ;;; Network process
 ;;


@@ -104,20 +111,23 @@
         (lirc-eval-msg-string (string-trim line))
       (setq lirc-response line))))
 
         (lirc-eval-msg-string (string-trim line))
       (setq lirc-response line))))
 

-(defun lirc-get-process ()
+(defun lirc-get-process (&optional connect)

   (let ((proc (get-process "lirc")))
     (if (and proc (eq (process-status proc) 'open))
         proc
   (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 nil
-                            :tls-parameters (cons 'gnutls-x509pki
-                                                  (gnutls-boot-parameters
-                                                   :type 'gnutls-x509pki
-                                                   :hostname lirc-host))
-                            :buffer "*lirc*"))))
+      (if connect
+          (make-network-process :name "lirc"
+                                :host lirc-host
+                                :service lirc-port
+                                :filter #'lirc-filter
+                                :nowait nil
+                                :tls-parameters (cons 'gnutls-x509pki
+                                                      (gnutls-boot-parameters
+                                                       :type 'gnutls-x509pki
+                                                       :hostname lirc-host))
+                                :buffer "*lirc*")
+        (lirc-display-error "No server connection established.")
+        (error "No server connection established")))))

 
 ;;; Messages
 ;;
 
 ;;; Messages
 ;;


@@ -253,6 +263,7 @@ portion of the source component of the message, as LIRC doesn't use this.")
                      'read-only t))))))
 
 (defun lirc-connect ()
                      'read-only t))))))
 
 (defun lirc-connect ()

+  (lirc-get-process t)

   (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)))
 
   (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)))
 


@@ -262,9 +273,9 @@ portion of the source component of the message, as LIRC doesn't use this.")
 
 (defun lirc-render-prompt ()
   (with-current-buffer "*lirc*"
 
 (defun lirc-render-prompt ()
   (with-current-buffer "*lirc*"

-    (set-marker-insertion-type lirc-prompt-marker nil)
-    (set-marker-insertion-type lirc-input-marker t)

     (save-excursion
     (save-excursion

+      (set-marker-insertion-type lirc-prompt-marker nil)
+      (set-marker-insertion-type lirc-input-marker t)

       (let ((inhibit-read-only t))
         (delete-region lirc-prompt-marker lirc-input-marker)
         (goto-char lirc-prompt-marker)
       (let ((inhibit-read-only t))
         (delete-region lirc-prompt-marker lirc-input-marker)
         (goto-char lirc-prompt-marker)


@@ -277,8 +288,8 @@ portion of the source component of the message, as LIRC doesn't use this.")
          (propertize lirc-prompt-string
                      'face 'lirc-prompt
                      'read-only t
          (propertize lirc-prompt-string
                      'face 'lirc-prompt
                      'read-only t

-                     'rear-nonsticky t)))))
-  (set-marker-insertion-type lirc-input-marker nil))
+                     'rear-nonsticky t)))
+      (set-marker-insertion-type lirc-input-marker nil))))

   
 (defvar lirc-prompt-marker nil
   "Marker for prompt position in LIRC buffer.")
   
 (defvar lirc-prompt-marker nil
   "Marker for prompt position in LIRC buffer.")


@@ -322,6 +333,11 @@ portion of the source component of the message, as LIRC doesn't use this.")
 (defun lirc-display-notice (&rest notices)
   (lirc-display-string lirc-notice-prompt " " (apply #'concat notices)))
 
 (defun lirc-display-notice (&rest notices)
   (lirc-display-string lirc-notice-prompt " " (apply #'concat notices)))
 

+(defun lirc-display-error (&rest messages)
+  (lirc-display-string lirc-error-prompt " "
+                       (propertize (apply #'concat messages)
+                                   'face 'lirc-error)))
+

 ;;; Message evaluation
 ;;
 
 ;;; Message evaluation
 ;;
 


@@ -352,6 +368,7 @@ portion of the source component of the message, as LIRC doesn't use this.")
        (let ((channel (car (lirc-msg-params msg))))
          (setq lirc-current-channel channel)
          (lirc-add-channel channel)
        (let ((channel (car (lirc-msg-params msg))))
          (setq lirc-current-channel channel)
          (lirc-add-channel channel)

+         (lirc-display-notice "Joining channel " channel)

          (lirc-render-prompt)))
 
       ("JOIN"
          (lirc-render-prompt)))
 
       ("JOIN"


@@ -362,6 +379,7 @@ portion of the source component of the message, as LIRC doesn't use this.")
 
       ((and "PART"
             (guard (equal lirc-nick (lirc-msg-src msg))))
 
       ((and "PART"
             (guard (equal lirc-nick (lirc-msg-src msg))))

+       (lirc-display-notice "Left channel " lirc-current-channel)

        (setq lirc-current-channel nil)
        (lirc-del-channel (car (lirc-msg-params msg)))
        (lirc-render-prompt))
        (setq lirc-current-channel nil)
        (lirc-del-channel (car (lirc-msg-params msg)))
        (lirc-render-prompt))