add conditions; stty now check performed changes and can signal conditions if fall

Nikolay V. Razbegaev [2009-11-10 13:49]
add conditions; stty now check performed changes and can signal conditions if fall
Filename
conditions.lisp
iolib.termios.asd
pkgdcl.lisp
wrapers.lisp
diff --git a/conditions.lisp b/conditions.lisp
new file mode 100644
index 0000000..9476ba9
--- /dev/null
+++ b/conditions.lisp
@@ -0,0 +1,26 @@
+;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
+;; common lisp wrapers for termios (3) api - conditions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(in-package :iolib.termios)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define-condition termios-error (iolib-error)
+  ()
+  (:documentation "Foundation of all iolib.termios conditions"))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define-condition termios-set-failled (termios-error)
+  ((request :initarg :request :reader request))
+  (:report
+   (lambda (c s)
+     (declare (ignorable c))
+     (format s "Failled apply ~a request on serial device" (request c))))
+  (:documentation
+   "Signalled when `stty' failled to apply one of the requested settings"))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define-condition termios-speed-failled (termios-set-failled)
+  ()
+  (:report
+   (lambda (c s)
+     (declare (ignorable c))
+     (format s "Failled to setup ~a baud speed on serial device" (request c))))
+  (:documentation "Signalled by `stty' when requested speed is unsupported"))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/iolib.termios.asd b/iolib.termios.asd
index b150047..fdf21bb 100644
--- a/iolib.termios.asd
+++ b/iolib.termios.asd
@@ -15,6 +15,7 @@
    #+unix(cffi-grovel:grovel-file "ffi-termios-types-unix")
    #+unix(cffi-grovel:grovel-file "ffi-termios-constants")
    #+unix(:file "ffi-termios-functions-unix")
-   #+unix(:file "wrapers")
+   (:file "conditions")
+   (:file "wrapers")
    (:file "streams")))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/pkgdcl.lisp b/pkgdcl.lisp
index dc50f26..55131ed 100644
--- a/pkgdcl.lisp
+++ b/pkgdcl.lisp
@@ -141,6 +141,10 @@
    #:write-timeout
    ;; useful wrapers:
    #:stty
+   ;; coditions:
+   #:termios-error
+   #:termios-set-failled
+   #:termios-speed-failled
    ;; additional stty options:
    #:raw
    #:cooked
@@ -150,5 +154,7 @@
    #:open-serial-stream
    #:with-serial-stream
    ;; List of all open serial streams. Could be used in signal handlers.
-   #:*open-serial-streams*))			; </ defpackage >
+   #:*open-serial-streams*
+   ;; Known baud rates constants list
+   #:*baud-rates*))			; </ defpackage >
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/wrapers.lisp b/wrapers.lisp
index 15a2019..19c26ec 100644
--- a/wrapers.lisp
+++ b/wrapers.lisp
@@ -189,10 +189,45 @@
 	       (t (if (atom option)
 		      (set-termios-option termios option)
 		      (set-termios-option termios (first option)
-					  (second option)))))))
-    (with-foreign-object (ptr 'termios)
-      (%tcgetattr fd ptr)
+					  (second option))))))
+           (compare-termios (set test)
+             (and
+              (every #'(lambda (flag)
+                         (=  (foreign-slot-value set  'termios flag)
+                             (foreign-slot-value test 'termios flag)))
+                     '(iflag oflag cflag lflag))
+              (dotimes (i nccs t)
+                (when
+                    (/= (mem-aref (foreign-slot-pointer set
+                                                        'termios
+                                                        'control-chars)
+                                  'cc
+                                  i)
+                        (mem-aref (foreign-slot-pointer test
+                                                        'termios
+                                                        'control-chars)
+                                  'cc
+                                  i))
+                  (return nil))))))
+    (with-foreign-objects ((set  'termios)
+                           (test 'termios))
+      (%tcgetattr fd set)
+      ;; As said in man termios:
+      ;; "tcsetattr() returns success if any of the
+      ;; requested changes could be successfully carried out."
+      ;; This manual also recomend to use tcgetattr() in oder to check
+      ;; all performed settings. But I really dot't like to find back
+      ;; that each zero ore one in coresponding field mead. So I prefer
+      ;; to process each option step by step and singnal a condition
+      ;; when there will be a difference:
       (dolist (option options)
-	(process-option option ptr))
-      (%tcsetattr fd tcsanow ptr))))
+	(process-option option set)
+        (%tcsetattr fd tcsanow set)
+        (%tcgetattr fd test)
+        (or (compare-termios set test)
+            (if (member option *baud-rates*)
+                (error 'termios-speed-failled
+                       :request (parse-integer (symbol-name option) :start 1))
+                (error 'termios-set-failled
+                       :request option)))))))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ViewGit