(moduletoolmzscheme
(require (planet"file.ss" ("dherman""io.plt"16))
(lib"file.ss")
(lib"framework.ss""framework")
(lib"tool.ss""drscheme")
(lib"match.ss")
(lib"mred.ss""mred")
(lib"unitsig.ss")
(lib"class.ss")
(lib"string-constant.ss""string-constants")
(lib"etc.ss")
"parser.scm""syntax-coloring.scm";"syntax/parse.ss"
;"compiler/compile.ss"
;(all-except "runtime/runtime.ss" object?)
;"exn.ss"
)
(definetool@
(unit/sigdrscheme:tool-exports^
(importdrscheme:tool^)
;;;
;;; PHASE 1
;;;
; Phase1 is called after all tools have been loaded by DrScheme.
; Phase 1 functions are drscheme:language:extend-language-interface
; and drscheme:unit:add-to-program-editor-mixin.
(define (phase1) (void))
;;;
;;; PHASE 2
;;;
; Phase 2 functions are
; - drscheme:language-configuration:add-language
; - drscheme:language:get-default-mixin
; - drscheme:language:get-language-extensions
(define (phase2)
(drscheme:language-configuration:add-language
(make-object ((drscheme:language:get-default-mixin)
(stylesheet-lang-mixin'stylesheet)))))
(define (stylesheet-lang-mixinlevel)
(class*object% (drscheme:language:language<%>)
; config-panel
; This method used by the language configuration dialog to construct
; the "details" panel for this language. It accepts a parent panel and
; returns a get/set function that either updates the GUI to the argument
; or returns the settings for the current GUI.
(define/public (config-panelparent)
(case-lambda
[() null]
[(settings) (void)]))
; create-executable
; This method creates an executable in the given language. The program-filename
; is the name of the program to store in the executable and executable-filename
; is the name of a file where the executable goes.
(define/public (create-executablesettingsparentsrc-fileteachpacks)
(message-box"Unsupported""Cascading Style Sheets are static text files."parent))
; default-settings
; Specifies the default settings for this language.
(define/public (default-settings) null)
; default-settings?
; Return #t if the input settings matches the default settings obtained via default-settings.
(define/public (default-settings?settings) #t)
; first-opened
; This method is called when the language is initialized, but no
; program is run. It is called from the user's eventspace's main thread.
(define/public (first-opened) (void))
; front-end/complete-program
; the front-end/complete-program method reads, parses, and optionally compiles
; a program in the language. The first argument contains all of the data to be
; read (until eof) and the second argument is a value representing the source
; of the program (typically an editor, but may also be a string naming a file
; or some other value).
; The third argument is the current settings for the language. The
; front-end/complete-program method is expected to return a thunk that is called
; repeatedly to get all of the expressions in the program. When all expressions
; have been read, the thunk is expected to return eof.
; This method is only called for programs in the definitions window. Notably, it
; is not called for programs that are loaded or evaled. See current-load and
; current-eval for those.
; This method is expected to raise an appropriate exception if the program is
; malformed, eg an exn:syntax or exn:read.
; This is called on the user's thread, as is the thunk it returns.
; Implementations of this method should not return fully expanded expressions, since
; there are two forms of expansion, using either expand or expand-top-level-with-compile-time-evals
; and the use of the expanded code dictates which applies.
(define/public (front-end/complete-programportsettingsteachpack-cache)
(front-endportsettings))
(define/private (front-endportsettings)
(let ([name (object-nameport)])
(lambda ()
(if (eof-object? (peek-charport))
eof#`'#,(parse-css-portportname)))))
; front-end/interaction
; This method is just like front-end/complete-program except that it is called
; with program fragments, for example the expressions entered in the interactions
; window. It is also used in other contexts by tools to expand single expressions.
(define/public (front-end/interactionportsettingsteachpack-cache)
(front-endportsettings))
; get-comment-character
; Returns text to be used for the ``Insert Large Letters'' menu item in DrScheme.
; The first result is a prefix to be placed at the beginning of each line and the
; second result is a character to be used for each pixel in the letters.
(define/public (get-comment-character)
(values)) ; disable
; get-language-name
; Returns the name of the language as shown in the REPL when executing
; programs in the language.
(define/public (get-language-name)
"Stylesheet")
; get-language-numbers
; This method is used in a manner analogous to get-language-position.
; Each element in the list indicates how the names at that point in dialog will
; be sorted. Names with lower numbers appear first. If two languages are added to
; DrScheme with the same strings (as given by the get-language-position method)
; the corresponding numbers returned by this method must be the same.
(define/public (get-language-numbers)
(list100012)) ; TODO: check numbers
; get-language-position
; This method returns a list of strings that is used to organize this language
; with the other languages. Each entry in that list is a category or subcategory of
; the language and the last entry in the list is the name of the language itself. In
; the language dialog, each element in the list except for the last will be a nested
; turn down triangle on the left of the dialog. The final entry will be the name that
; the user can choose to select this language. Names that are the same will be combined
; into the same turndown entry. [See example in HelpDesk manual]
(define/public (get-language-position)
(list (string-constantexperimental-languages)
"Stylesheet"))
; get-language-url
; Returns a url for the language.
(define/public (get-language-url)
"http://http://www.w3.org/TR/CSS21/cover.html")
; get-oneline-summary
; The result of this method is shown in the language dialog when the user
; selects this language.
(define/public (get-one-line-summary)
"CSS 2.1 (Cascading Style Sheets)")
; get-style-delta
; The style delta that this method returns is used in the language dialog and the
; DrScheme REPL when the language's name is printed.
; When it is #f, no styling is used.
; If the result is a list, each element is expected to be a list of three items,
; a style-delta, and two numbers. The style delta will be applied to the corresponding
; portion of the name.
(define/public (get-style-delta)
#f)
; marshall-settings
; Translates an instance of the settings type into a scheme object that can
; be written out to disk.
(define/public (marshall-settingss) null)
; unmarshall-settings
; Translates a Scheme value into a settings, returning #f if that is not possible.
(define/public (unmarshall-settingss) null)
; on-execute
; The on-execute method is called on DrScheme's eventspace's main thread before any
; evaluation happens during execution. Use this method to initialize MzScheme's parameters
; for the user. [See more in the HelpDesk manual]
(define/public (on-executesettingsrun-in-user-thread)
; (read-case-sensitive #f)
(run-in-user-thread
(lambda ()
(error-display-handler
(drscheme:debug:make-debug-error-display-handler (error-display-handler)))
(error-print-source-location#t)
(void))))
; order-manuals
; Returns a sublist of its input, that specifies the manuals (and their order) to
; search in. The boolean result indicates if doc.txt files should be searched.
(define/public (order-manualsx)
(values
(list#"drscheme"#"tour"#"help")
#t))
; render-value
; This method is just like render-value/format except that it is expected to
; put the entire value on a single line with no newline after the value.
(define/public (render-valuevaluesettingsport)
(displayvalueport))
; render-value/format
; This method is used to print values into a port, for display to a user.
; The final argument is a maximum width to use (in characters) when formatting
; the value.
; This method is expected to format the value by inserting newlines in appropriate
; places and is expected to render a newline after the value.
(define/public (render-value/formatvaluesettingsportwidth)
(displayvalueport))
; ???
(define/public (get-teachpack-names) null)
(super-make-object)))
;; short-sym->pref-name : symbol -> symbol
;; returns the preference name for the color prefs
(define (short-sym->pref-namesym) (string->symbol (short-sym->style-namesym)))
;; short-sym->style-name : symbol->string
;; converts the short name (from the table above) into a name in the editor list
;; (they are added in by `color-prefs:register-color-pref', called below)
(define (short-sym->style-namesym) (format"stylesheet:syntax-coloring:scheme:~a"sym))
;; Editing colors
(definecolor-prefs-table`((keyword,(make-objectcolor%"purple") "keyword")
(parenthesis,(make-objectcolor%1326036) "parenthesis")
(string,(make-objectcolor%"forestgreen") "string")
(literal,(make-objectcolor%"forestgreen") "literal")
(comment,(make-objectcolor%19411631) "comment")
(error,(make-objectcolor%"red") "error")
(identifier,(make-objectcolor%3838128) "identifer")
(default,(make-objectcolor%"black") "default")))
;; extend-preferences-panel : vertical-panel -> void
;; adds in the configuration for the Honu colors to the prefs panel
(define (extend-preferences-panelparent)
(for-each
(lambda (line)
(let ([sym (carline)])
(color-prefs:build-color-selection-panelparent
(short-sym->pref-namesym)
(short-sym->style-namesym)
(format"~a"sym))))
color-prefs-table))
;; Stylesheet editing mode
(definemode-surrogate
(newcolor:text-mode%
(matches (list (list'|{| '|}|)
(list'|(| '|)|)
(list'|[| '|]|)))
(get-tokenget-syntax-token)
(token-sym->styleshort-sym->style-name)))
(define (matches-language?l)
(matchl
[(_"Stylesheet" . _) #t]
[_#f]))
(define (delimiter-pair?xy)
(or (and (char=?x#\() (char=?y#\)))
(and (char=?x#\[) (char=?y#\]))
(and (char=?x#\{) (char=?y#\}))))
;; repl-submit? : drscheme:rep:text<%> nat -> boolean
(define (repl-submit?textprompt-position)
(letloop ([iprompt-position]
[blank?#t]
[string-char#f]
[delimiter-stacknull])
(let ([c (sendtextget-characteri)])
(casec
[(#\nul)
(and (notblank?)
(notstring-char)
(null?delimiter-stack))]
[(#\(#\[#\{)
(ifstring-char
(loop (add1i) #fstring-chardelimiter-stack)
(loop (add1i) #f#f (conscdelimiter-stack)))]
[(#\)#\]#\})
(cond
[string-char
(loop (add1i) #fstring-chardelimiter-stack)]
[(and (pair?delimiter-stack)
(delimiter-pair? (cardelimiter-stack) c))
(loop (add1i) #f#f (cdrdelimiter-stack))]
[else
(loop (add1i) #f#fdelimiter-stack)])]
[(#\'#\")
(cond
[(andstring-char (char=?cstring-char))
(loop (add1i) #f#fdelimiter-stack)]
[string-char
(loop (add1i) #fstring-chardelimiter-stack)]
[else
(loop (add1i) #fcdelimiter-stack)])]
[(#\\)
(ifstring-char
(loop (+i2) #f#fstring-chardelimiter-stack)
(loop (add1i) #f#fstring-chardelimiter-stack))]
[else
(loop (add1i)
(andblank? (char-whitespace?c))
string-chardelimiter-stack)]))))
;; Wire up to DrScheme.
(drscheme:modes:add-mode"Stylesheet mode"mode-surrogaterepl-submit?matches-language?)
(color-prefs:add-to-preferences-panel"Stylesheet"extend-preferences-panel)
(for-each (lambda (line)
(let ([sym (carline)]
[color (cadrline)])
(color-prefs:register-color-pref (short-sym->pref-namesym)
(short-sym->style-namesym)
color)))
color-prefs-table)))
(providetool@))