Racket 语言编写的一个简单记事本程序

#lang racket/gui
;;;; RacketNote --- a notepad based on racket
;;;; Author: leesper

;;; definition of the RacketNoteGui

(define app-name " RacketNote")
(define version " v0.0.9")
(define app-label (string-append "*Untitled" app-name version))
(define window-width 600)
(define window-height 400)

(define editor (new text%))

(define racket-note-gui%
(class frame%

(define/public (clear-all)
(send editor select-all)
(send editor clear)
(send editor set-filename #f)
(send this refresh))

(define/augment (can-close?)
(ask-for-save? editor))

(define/public (ask-for-save? editor)
(if (send editor is-modified?)
(let ([res (message-box/custom "Save File" "Do you want to save this file ?"
"Yes" "No" "Cancel")])
(cond
[(= res 1) (send editor save-file
(send editor get-filename))]
[(= res 2) #t]
[else #f]))
#t))

(super-new (label app-label)
(width window-width)
(height window-height))))

(define note-gui (new racket-note-gui%))

;;; set up the editor on canvas
(define canvas (new editor-canvas%
(parent note-gui)))
(send canvas set-editor editor)

;;; menu system
(define menu-bar (new menu-bar%
(parent note-gui)))

;;; the file menu items
(define file-menu (new menu%
(label "&File")
(parent menu-bar)))

(new menu-item%
(label "&New")
(parent file-menu)
(callback (lambda (item event)
(when (send note-gui ask-for-save? editor)
(send note-gui clear-all)
(send editor set-filename #f)
(send note-gui set-label
(string-append "*Untitled"
app-name
version))))))

(new menu-item%
(label "&Open")
(parent file-menu)
(callback (lambda (item event)
(when (send note-gui ask-for-save? editor)
(let ([path (send editor get-file #f)])
(cond
[(path-string? path)
(send editor load-file path 'text)
(send editor set-filename path)
(send note-gui set-label
(string-append
(path->string (file-name-from-path path))
app-name version))
(send note-gui refresh)]
[else #t]))))))

(new menu-item%
(label "&Save")
(parent file-menu)
(callback (lambda (item event)
(send editor save-file
(send editor get-filename) 'text)
(send note-gui set-label
(string-append (path->string (file-name-from-path (send editor get-filename)))
app-name
version))
(send note-gui refresh))))

(new separator-menu-item%
(parent file-menu))

(new menu-item%
(label "&Quit")
(parent file-menu)
(callback (lambda (item event)
(send note-gui on-exit))))

;;; edit menu and font menu items set using default supporting by Racket
(define edit-menu (new menu%
(label "&Edit")
(parent menu-bar)))

(define font-menu (new menu%
(label "&Font")
(parent menu-bar)))

(append-editor-operation-menu-items edit-menu #f)
(append-editor-font-menu-items font-menu)

;;; help menu items
(define help-menu (new menu%
(label "&Help")
(parent menu-bar)))

(new menu-item%
(label "&About")
(parent help-menu)
(callback (lambda (item event)
(message-box "About RacketNote"
"RacketNote: A Simple Text Editor\n Author: Leesper"
note-gui '(ok caution)))))

(send note-gui show #t)