Part 2 of the MailEditir example "ME2.lsp"

[CaveGuy]

This is the second installment in the ME example application. This example expects that (ME:getpop) be executed first to load the 'mail-dir with "*.pop3" messages to process.

;; Expanded E-Mail examples

;;

;; to run: (ME:run)

;;

;; Version 0.1 (CaveGuy)

;; 



;; (ME:show-next-message uses 'ME:mail-dir previousily declaired

;; for the (POP3:get-all-mail function. 

;; Theis constant will be replaced by an INI file, or better yet

;; a self modifying code example :)

;;

;(setq ME:mail-dir        "your-mail-directory")

;

;; This directory has been pre-filled by the (ME:getpop example with Me-?????.pop3 files.

;

;; doit.lsp is a container for the loading of other personal

;; and application related contexts. This is also a good place to 

;; put personalization (setq's like the one required above.

;;

(if (file? "doit.lsp")(load "doit.lsp"))



;; (ME:run display message and prompt for status.

;;

;; (ME:init-window-1, defines and puts up a window

;; (ME:show-next-msg, displays a ".pop3" message body and header,

;; then waits on user input via callbacks for the Good/SPAM decision.

;;

(define (ME:run)

   (ME:init-window-1)

   (ME:show-next-msg) )



;; Init - Display/Good/SPAM window

;;    

(define (ME:init-window-1)

   (ME:MakeCentered ".window-1" 600 400)   

   (tk "frame .window-1.frame-0")   

   (tk "label .window-1.frame-0.label -text {Current Message/File}")

   (tk "label .window-1.frame-0.file")

   (tk "pack .window-1.frame-0.label .window-1.frame-0.file -side top -padx 10 -pady 5")

   (tk "pack .window-1.frame-0") 

   (tk "frame .window-1.frame-1")  

   (tk "scrollbar .window-1.frame-1.scroll -command ".window-1.frame-1.text yview"")

   (tk "text .window-1.frame-1.text -height 4 -yscrollcommand ".window-1.frame-1.scroll set"")

   (tk "pack .window-1.frame-1.scroll -side right -fill y")

   (tk "pack .window-1.frame-1.text -side bottom")

   (tk "pack .window-1.frame-1")  

   (tk "frame .window-1.frame-x")  

   (tk "label .window-1.frame-x.spacer -text {-----------}") 

   (tk "pack .window-1.frame-x.spacer -side bottom")  

   (tk "pack .window-1.frame-x")    

   (tk "frame .window-1.frame-2")  

   (tk "scrollbar .window-1.frame-2.scroll -command ".window-1.frame-2.text yview"")

   (tk "text .window-1.frame-2.text -height 10 -yscrollcommand ".window-1.frame-2.scroll set"")

   (tk "pack .window-1.frame-2.scroll -side right -fill y")

   (tk "pack .window-1.frame-2.text -side bottom")

   (tk "pack .window-1.frame-2")    

   (tk "frame .window-1.frame-3")  

   (tk "button .window-1.frame-3.good -text Good -padx 10 -pady 5")

   (tk "button .window-1.frame-3.spam -text SPAM -padx 10 -pady 5")

   (tk "button .window-1.frame-3.exit -text Exit -padx 10 -pady 5")

   (tk "pack .window-1.frame-3.good .window-1.frame-3.spam .window-1.frame-3.exit")    

   (tk ".window-1.frame-3.good config -command {Newlisp {(silent (ME:good-button))} }")

   (tk ".window-1.frame-3.spam config -command {Newlisp {(silent (ME:spam-button))} }")

   (tk ".window-1.frame-3.exit config -command {Newlisp {(silent (ME:exit-button))} }") 

   (tk "grid .window-1.frame-3.good .window-1.frame-3.spam .window-1.frame-3.exit -row 1 -padx 20 -pady 20")

   (tk "pack .window-1.frame-3") )



;; MakeCentered Example cliped from the newLISP forum 

;;

(define (ME:MakeCentered win ww hh , w h x y) 

   (set 'w (integer (tk "winfo screenwidth ."))

        'h (integer (tk "winfo screenheight ."))

        'x (/ (- w ww) 2)

        'y (/ (- h hh) 2))

   (tk "toplevel " win "; wm geometry " win " =" ww "x" hh "+" x "+" y)) 

;         

;; Exit button callback

;;

(define (ME:exit-button)

   (exit) )

 

;; Good button call back

;;

(define (ME:good-button)

   (ME:change-file-type "good") 

   (ME:show-next-msg) )

   

;; SPAM button call back

;;  

(define (ME:spam-button)

   (ME:change-file-type "spam") 

   (ME:show-next-msg) )



;; Change message file type from ".pop3" 

;; to good or spam based on 'gorb.

;; or change .good to .SPAM or .spam to .GOOD.

;;

(define (ME:change-file-type gorb , new-name base-name type)

   (set 'base-name (chop ME:message-file-name 4))  

   (set 'new-name (cond ((and (= gorb "spam")

                              (file? (append base-name "good")))

                         (delete-file (append base-name "good"))

                         (append base-name "SPAM"))

                        ((and (= gorb "good")

               (file? (append base-name "spam")))

                         (delete-file (append base-name "spam"))

                         (append base-name "GOOD"))

                        (true (append base-name gorb))))

   (if (not (file? new-name))

       (rename-file ME:message-file-name new-name)

       (delete-file ME:message-file-name)) )



;; Grab next ".pop3" file, and display it

;;

(define (ME:show-next-msg , file-handle file-lst do-header text-line) 

   (tk ".window-1.frame-1.text delete 1.0 end")

   (tk ".window-1.frame-2.text delete 1.0 end")

   (if (ends-with ME:mail-dir "/") (set 'mail-dir (chop ME:mail-dir 1)))

   (set 'file-lst (filter (lambda (x) (ends-with x ".pop3" nil)) 

                           (directory ME:mail-dir)))

   (if (> (length file-lst) 0)

       (begin

          (set 'ME:message-file-name (append ME:mail-dir "/" (first file-lst)))

          (tk ".window-1.frame-0.file config -text " ME:message-file-name)

     (set 'file-handle (open ME:message-file-name "read")

          'do-header true)

     (while (read-line file-handle)

        (if do-header 

           (begin

              (set 'do-header nil)

              (while (!= (set 'text-line (read-line file-handle)) "")

                 (replace "{" text-line "\{") 

                 (replace "}" text-line "\}") 

                 (replace "[" text-line "\[") 

                 (replace "]" text-line "\]") 

                 (replace "$" text-line "\$") 

                 (tk ".window-1.frame-1.text insert end [subst {" text-line "\n}]"))

              (tk "pack .window-1.frame-1.text") ) 

           (begin  

              (set 'text-line (current-line))      

              (replace "{" text-line "\{") 

              (replace "}" text-line "\}") 

              (replace "[" text-line "\[") 

              (replace "]" text-line "\]") 

              (replace "$" text-line "\$") 

              (tk ".window-1.frame-2.text insert end [subst {" text-line "\n}]"))))

     (tk "pack .window-1.frame-2.text")  

     (close file-handle))) )

;

; End of file

[Lutz]

just tried both examples, very nice



Lutz

[CaveGuy]

I would like to see a pull down user interface that looks very much like the newLISP-tk edit window.



I never got the horizontal scroll bar working with the message area text box. I need an example of dual scroll bars on one text box.



Feel free to hack at these examples, I hope to continue learning from them too :)

[Lutz]

look into the function 'CodeBrowser' in the file 'newlisp-tk.tcl' in the newlisp_7002.tgz source distribution.



You put the scrollbar in the parent window of the text control.  Escape the quotes inside the tk string with one backslash:



(tk "toplevel .mywin")

(tk "text .mywin.txt")

(tk "scrollbar  .mywin.scroll -command ".mywin.txt yview" ")

(tk ".mywin.text config -yscrollcommand ".mywin.scroll set " ")



...

...



Lutz