[ltk-user] Saving entry content to file

Louis A. Turk lou at dayspringpublisher.com
Wed Sep 1 06:44:55 UTC 2010


Hi Peter Herth and everyone else,

I'm rather new to Lisp and to LTK, but learning steadily. I'm stuck with
a problem. I've successfully used ltk to create a form, but don't know
how to save the data entered into the form to my database. I suspect
that my problem is improperly supplying the data from the entry widget
to the store-save-rec function (see line 279 below). But I may just have
something else fundamentally wrong.

Would someone please tell me what I'm doing wrong, and how to fix it?

I'm using ltk 0.91

Thanks in advance!
Lou

PS Also, how do I clear all the fields in preparation for entering
another record of data?

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; DICTIONARY AND INTERLINEAR MAKER 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package :lat-il)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;             Definations for the dictionary code.  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar *recs* (make-array 100 :adjustable t :fill-pointer 0)
  "A vector of dictionary records.")

(defvar *index-numbers* (make-hash-table :test #'equal)
  "The dictionary index numbers.")

(defvar *greek-words* (make-hash-table :test #'equal)
  "Greek words")

(defstruct (rec
             (:print-function
              (lambda (rec stream depth)
                (declare (ignore depth))
                (format stream "#S(REC ~% INDEX ~S ~% FREQ ~S ~% STRONG
~S ~% PART ~S ~% INFLEXION ~S ~% BWROOT ~S ~% ROOT ~S ~% BWGRKL ~S ~%
GREEK ~S ~% INDO ~S ~% ENG ~S ~% ARTI ~S ~% DEFIN ~S) ~%"
                        (rec-index rec)
                        (rec-freq rec)
                        (rec-strong rec)
                        (rec-part rec)
                        (rec-inflexion rec)
                        (rec-bwroot rec)
                        (rec-root rec)
                        (rec-bwgrkl rec)
                        (rec-greek rec)
                        (rec-indo rec)
                        (rec-eng rec)
                        (rec-arti rec)
                        (rec-defin rec)))))
index freq strong part inflexion bwroot root bwgrkl greek indo eng arti
defin)

(defun store-rec (index freq strong part inflexion bwroot root bwgrkl
greek indo eng arti defin)
  "Stores a record into the dictionary in memory."
  (let ((new-rec (make-rec
                     :index index
                     :freq freq
                     :strong strong
                     :part part
                     :inflexion inflexion
                     :bwroot bwroot
                     :root root
                     :bwgrkl  bwgrkl
                     :greek greek
                     :indo indo
                     :eng eng
                     :arti arti
                     :defin defin)))
    (vector-push-extend new-rec *recs*)
    (push new-rec (gethash index *index-numbers*))
    (push new-rec (gethash greek *greek-words*))
    new-rec))

;;; Macro to make the input output functions
(defmacro def-i/o (writer-name reader-name (&rest vars))
  (let ((file-name (gensym))
        (var (gensym))
        (stream (gensym)))
    `(progn
       (defun ,writer-name (,file-name)
         (with-open-file (,stream ,file-name
                                  :external-format :utf-8
                                  :direction :output 
                                  :if-exists :supersede)
           (dolist (,var (list , at vars))
             (declare (special , at vars))
             (print ,var ,stream))))
       (defun ,reader-name (,file-name)
         (with-open-file (,stream ,file-name
                                  :external-format :utf-8 
                                  :direction :input 
                                  :if-does-not-exist nil)
           (dolist (,var ',vars)
             (set ,var (read ,stream)))))
       t)))

;;; Expand the above macro for use.
(def-i/o save-recs load-recs (*recs* *index-numbers* *greek-words*))

(defun store-save-rec (index freq strong part inflexion bwroot root
bwgrkl greek indo eng arti defin)
  (store-rec index freq strong part inflexion bwroot root bwgrkl greek
indo eng arti defin)
  (save-recs "/home/lat/l/i/dict-data.txt"))

(defun get-rec (index)
  "Returns a dictionary record given its index number, or NIL if no such
record."
  (aref *recs* index))

(defun del-rec (index)
  "Deletes a record, returning T; else NIL if no such record."
  (let ((rec (get-rec index)))
    (when rec
      (setf (gethash (rec-greek rec) *greek-words*)
            (delete rec (gethash (rec-greek rec) *greek-words*)))
      (setf (aref *recs* index) nil)
      t)))

(defun list-all-recs ()
  "List all records in dictionary."
  (coerce *recs* 'list))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;               Definations for the interlinear code 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Unicode return-string-length function (calls zpb-ttf ) 

(defvar *box-deminsions* 0)

(defvar font-used
"/var/lib/defoma/x-ttcidfont-conf.d/dirs/TrueType/Times_New_Roman.ttf")

(defun return-str-len (str font-used)
  (setf *box-deminsions*
        (string-bounding-box str
                             (open-font-loader font-used)))
  (aref *box-deminsions* 2))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;                        Defination for the ltk gui loop 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun il-gui ()
  (setf *debug-tk* t)
  (with-ltk ()
    (let* ((f (make-instance 'frame :background "blue"))
           (name (make-instance 'label 
                                :text "Interl Maker" 
                                :width 10 
                                :foreground "black" 
                                :background "red" 
                                :master f))
           (ver (make-instance 'label 
                               :text "Version 5.0" 
                               :width 20 
                               :foreground "red" 
                               :background "black" 
                               :master f))
           (index-l (make-instance 'label 
                                :text "Index#:" 
                                :width 10 
                                :background "yellow" 
                                :master f))
           (index (make-instance 'entry 
                                :width 20 
                                :background "white" 
                                :master f))
           (freq-l (make-instance 'label 
                                  :text "Freq:" 
                                  :width 10 
                                  :background "yellow" 
                                  :master f))
           (freq (make-instance 'entry 
                                  :width 20 
                                  :background "white" 
                                  :master f))
           (strong-l (make-instance 'label 
                                  :text "Strong#:" 
                                  :width 10 
                                  :background "yellow" 
                                  :master f))
           (strong (make-instance 'entry 
                                  :width 20 
                                  :background "white" 
                                  :master f))
           (part-l (make-instance 'label 
                                  :text "Part:" 
                                  :width 10 
                                  :background "yellow" 
                                  :master f))
           (part (make-instance 'entry 
                                  :width 20 
                                  :background "white" 
                                  :master f))
           (inflexion-l (make-instance 'label 
                                  :text "Inflexion:" 
                                  :width 10 
                                  :background "yellow" 
                                  :master f))
           (inflexion (make-instance 'entry 
                                  :width 20 
                                  :background "white" 
                                  :master f))
           (bwroot-l (make-instance 'label 
                                    :text "BW-Root:" 
                                    :width 10 
                                    :background "yellow" 
                                    :master f))
           (bwroot (make-instance 'entry 
                                    :width 20 
                                    :background "white" 
                                    :master f))
           (root-l (make-instance 'label 
                                  :text "Root:" 
                                  :width 10 
                                  :background "yellow" 
                                  :master f))
           (root (make-instance 'entry 
                                  :width 20 
                                  :background "white" 
                                  :master f))
           (bwgrkl-l (make-instance 'label 
                                   :text "BWGrkL:" 
                                   :width 10 
                                   :background "yellow" 
                                   :master f))
           (bwgrkl (make-instance 'entry 
                                   :width 20 
                                   :background "white" 
                                   :master f))
           (greek-l (make-instance 'label 
                                   :text "Greek:" 
                                   :width 10 
                                   :background "yellow" 
                                   :master f))
           (greek (make-instance 'entry 
                                   :width 20 
                                   :background "white" 
                                   :master f))
           (indo-l (make-instance 'label 
                                  :text "Indonesian:" 
                                  :width 10 
                                  :background "yellow" 
                                  :master f))
           (indo (make-instance 'entry 
                                  :width 20 
                                  :background "white" 
                                  :master f))
           (eng-l (make-instance 'label 
                                 :text "English:" 
                                 :width 10 
                                 :background "yellow" 
                                 :master f))
           (eng (make-instance 'entry 
                                 :width 20 
                                 :background "white" 
                                 :master f))
           (f2 (make-instance 'frame 
                              :background "blue"))
           (arti-l (make-instance 'label 
                                  :text "Arti:" 
                                  :width 127 
                                  :background "yellow" 
                                  :master f2))
           (arti (make-instance 'text 
                                  :height 10 
                                  :width 127 
                                  :background "white" 
                                  :master f2))
           (defin-l (make-instance 'label 
                                   :text "Defination:" 
                                   :width 127 
                                   :background "yellow" 
                                   :master f2))
           (defin (make-instance 'text 
                                   :height 10 
                                   :width 127 
                                   :background "white" 
                                   :master f2))
           (lines-l (make-instance 'label 
                                   :text "Resultant Lines:" 
                                   :width 127 :background "yellow"
                                   :master f2))
           (lines (make-instance 'text 
                                   :height 20 
                                   :width 127 
                                   :background "white" 
                                   :master f2))
           (save-b (make-instance 'button 
                                  :text "Save" 
                                  :width 127 
                                  :background "green" 
                                  :master f2
                                   :command (store-save-rec   ;line 279
                                             index
                                             freq
                                             strong 
                                             part 
                                             inflexion 
                                             bwroot 
                                             root 
                                             bwgrkl 
                                             greek 
                                             indo 
                                             eng 
                                             arti 
                                             defin)))
           (clear-b (make-instance 'button 
                                   :text "Clear" 
                                   :master f2 
                                   :width 127 
                                   :background "red" 
                                   :master f2
                                   :command (lambda () (format t
"Hi.")))))
      (grid f 0 0)
      (grid name 1 0)
      (grid ver 1 1)
      (grid index-l 1 2)
      (grid index 1 3)
      (grid freq-l 1 4)
      (grid freq 1 5)
      (grid strong-l 1 6)
      (grid strong 1 7)
      (grid part-l 2 0)
      (grid part 2 1)
      (grid inflexion-l 2 2)
      (grid inflexion 2 3)
      (grid bwroot-l 2 4)
      (grid bwroot 2 5)
      (grid root-l 2 6)
      (grid root 2 7)
      (grid bwgrkl-l 3 0)
      (grid bwgrkl 3 1)
      (grid greek-l 3 2)
      (grid greek 3 3)
      (grid indo-l 3 4)
      (grid indo 3 5)
      (grid eng-l 3 6)
      (grid eng 3 7)
      (grid f2 4 0)
      (grid arti-l 5 0)
      (grid arti 6 0)
      (grid defin-l 7 0)
      (grid defin 8 0)
      (grid lines-l 9 0)
      (grid lines 10 0)
      (grid save-b 11 0)
      (grid clear-b 13 0)
      (configure f :wm-title "Interlinear Maker Version 5.0")
      (configure f :borderwidth 10))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;                                  Run the program
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;(load-recs "/home/lat/lisp/il-s/dict-data.txt")

(il-gui)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;                            END OF PROGRAM 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;







More information about the ltk-user mailing list