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.

<pre>
;; 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
</pre>

[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