From: Adam Chlipala Date: Sun, 11 Nov 2007 15:52:44 +0000 (+0000) Subject: Improved Emacs mode, with standard library 'keyword' table generated automatically... X-Git-Tag: release_2010-11-19~162 X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/commitdiff_plain/ef18a74197873c2b319c57ff5dacb2a09e234d76?hp=4542571e02a2517e6ca9c342d433343293b06be8 Improved Emacs mode, with standard library 'keyword' table generated automatically by domtool-doc --- diff --git a/elisp/domtool-mode-startup.el b/elisp/domtool-mode-startup.el index 2f5013d..c00df20 100644 --- a/elisp/domtool-mode-startup.el +++ b/elisp/domtool-mode-startup.el @@ -1,4 +1,4 @@ (autoload (quote domtool-mode) "domtool-mode/domtool-mode" "\ Major Mode for editing Domtool files." t nil) -(add-to-list (quote auto-mode-alist) (quote ("\\.\\(com\\|net\\|org\\|edu\\|mil\\|biz\\|info\\|name\\|be\\|ca\\|cc\\|de\\|fr\\|in\\|mu\\|se\\|uk\\|us\\|ws\\)" . domtool-mode))) +(add-to-list (quote auto-mode-alist) (quote ("\\.\\(com\\|net\\|org\\|edu\\|mil\\|biz\\|info\\|name\\|be\\|ca\\|cc\\|de\\|fr\\|in\\|mu\\|se\\|uk\\|us\\|ws\\)$" . domtool-mode))) diff --git a/elisp/domtool-mode.el b/elisp/domtool-mode.el index d1a4a98..3f8d193 100644 --- a/elisp/domtool-mode.el +++ b/elisp/domtool-mode.el @@ -37,16 +37,43 @@ )) table)) +(defun domtool-syms-re (&rest syms) + (concat "\\<" (regexp-opt syms t) "\\>")) + +(defconst domtool-types-regexp + (domtool-syms-re "proxy_target" "proxy_port" "mod_rewrite_cond_flag" "mod_rewrite_flag" "rewrite_arg" "redirect_code" "autoindex_option" "autoindex_width" "homedir_path" "dnsRecord" "apache_option" "authType" "location" "ssl" "ssl_cert_path" "suexec_flag" "web_node" "aliasTarget" "aliasSource" "email" "emailUser" "mail_node" "dnsKind" "master" "dns_node" "soa" "serial" "your_path" "your_group" "your_user" "group" "user" "node" "your_domain_host" "your_domain" "domain" "host" "ip" "no_newlines" "no_spaces" "bool" "string" "int") + "A regexp that matches Domtool types from the standard library.") + +(defconst domtool-contexts-regexp + (domtool-syms-re "Location" "Vhost" "Domain") + "A regexp that matches Domtool contexts from the standard library.") + +(defconst domtool-actions-regexp + (domtool-syms-re "errorDocument" "scriptAlias" "alias" "proxyPassReverse" "proxyPass" "rewriteLogLevel" "localProxyRewrite" "rewriteBase" "rewriteCond" "rewriteRule" "setEnv" "davFilesystem" "readmeName" "headerName" "unset_indexOptions" "set_indexOptions" "indexOptions" "addDescription" "mailmanWebHost" "dnsDefault" "dnsAlias" "dnsMail" "dnsIP" "nameserver" "dom" "web" "webAt" "relayMail" "handleMail" "dns" "addDefaultCharset" "action" "forceTypeOff" "forceType" "directoryIndex" "unset_options" "set_options" "options" "satisfyAny" "satisfyAll" "denyFrom" "denyFromAll" "allowFrom" "allowFromAll" "orderDenyAllow" "orderAllowDeny" "requireGroup" "requireUser" "requireValidUser" "authUserFile" "authName" "authType" "serverAliasDefault" "serverAlias" "serverAliasHost" "directory" "location" "vhost" "defaultAlias" "aliasDrop" "aliasMulti" "emailAlias" "aliasPrim" "domain") + "A regexp that matches Domtool actions from the standard library.") + +(defconst domtool-vals-regexp + (domtool-syms-re "ornext" "cond_nocase" "env" "skip" "redirectWith" "mimeType" "passthrough" "noescape" "qsappend" "nocase" "nosubreq" "chain" "last" "gone" "forbidden" "redirect" "redir307" "redir305" "redir304" "redir303" "redir302" "redir301" "redir300" "seeother" "permanent" "temp" "xhtml" "versionSort" "trackModified" "suppressSize" "suppressRules" "suppressLastModified" "suppressIcon" "suppressHtmlPreamble" "suppressDescription" "suppressColumnSorting" "scanHtmlTitles" "nameWidth" "ignoreClient" "ignoreCase" "iconWidth" "iconHeight" "iconsAreLinks" "htmlTable" "foldersFirst" "fancyIndexing" "descriptionWidth" "characters" "autofit" "home" "web_node" "default_node" "dnsDefaultA" "dnsNS" "dnsMX" "dnsCNAME" "dnsA" "indexes" "includesNOEXEC" "execCGI" "kerberos" "digest" "basic" "use_cert" "no_ssl" "web_node_to_node" "dropTarget" "addressesTarget" "addressTarget" "catchAllSource" "defaultSource" "userSource" "mail_node_to_node" "noDns" "useDns" "internalMaster" "externalMaster" "dns_node_to_node" "defaultSoa" "soa" "serialConst" "serialAuto" "ip_of_node" "true" "false") + "A regexp that matches Domtool vals from the standard library.") + +(defconst domtool-env-vars-regexp + (domtool-syms-re "Aliases" "DNS" "DocumentRoot" "Group" "MailNodes" "Mailbox" "SSL" "ServerAdmin" "SuExec" "TTL" "User" "WebNodes") + "A regexp that matches Domtool env-vars from the standard library.") + (defvar domtool-font-lock-keywords `(,(concat "\\_<" (regexp-opt '("let" "in" "begin" "end" "with" "where" "extern" "type" - "val" "context" "Root" - ;; Actions - "vhost" "location" "directory" "domain" "dom" - "webAt" "web") + "val" "context" "Root") t) "\\_>") + + (,domtool-actions-regexp . font-lock-builtin-face) + (,domtool-vals-regexp . font-lock-variable-name-face) + (,domtool-contexts-regexp . font-lock-constant-face) + (,domtool-env-vars-regexp . font-lock-constant-face) + (,domtool-types-regexp . font-lock-type-face) + ("type[ \t]+\\(\\(\\sw\\|\\s_\\)+\\)" 1 font-lock-type-face) ("val[ \t]+\\(\\(\\sw\\|\\s_\\)+\\)" 1 font-lock-variable-name-face))) diff --git a/src/autodoc.sig b/src/autodoc.sig index 8f52802..c36ee33 100644 --- a/src/autodoc.sig +++ b/src/autodoc.sig @@ -21,5 +21,6 @@ signature AUTODOC = sig val autodoc : {outdir : string, infiles : string list} -> unit + val makeEmacsKeywords : string list -> unit end diff --git a/src/autodoc.sml b/src/autodoc.sml index 86c8651..640012c 100644 --- a/src/autodoc.sml +++ b/src/autodoc.sml @@ -1,5 +1,5 @@ (* HCoop Domtool (http://hcoop.sourceforge.net/) - * Copyright (c) 2006, Adam Chlipala + * Copyright (c) 2006-2007, Adam Chlipala * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License @@ -187,4 +187,72 @@ fun autodoc {outdir, infiles} = app doFile infiles end +fun makeEmacsKeywords infiles = + let + val (_, infiles) = Order.order NONE infiles + val G = foldl (fn (fname, G) => check' G fname) Env.empty infiles + + fun annotate_decl d = + case d of + DVal (name, NONE, e) => + (case Env.lookupVal G name of + NONE => d + | SOME t => DVal (name, SOME t, e)) + | _ => d + + fun doFile (file, acc) = + let + val (_, decls, _) = Parse.parse file + + fun isAction evs (t, _) = + case t of + TAction (_, r1, r2) => + let + fun enrich (r, evs) = + StringMap.foldli (fn (ev, _, evs) => + StringSet.add (evs, ev)) + evs r + in + SOME (enrich (r2, enrich (r1, evs))) + end + | TArrow (_, t) => isAction evs t + | TNested (_, t) => isAction evs t + | TUnif (_, ref (SOME t)) => isAction evs t + | _ => NONE + in + foldl (fn ((d, _, _), (types, contexts, actions, vals, evs)) => + case annotate_decl d of + DExternType s => (s :: types, contexts, actions, vals, evs) + | DExternVal (s, t) => + (case isAction evs t of + SOME evs => (types, contexts, s :: actions, vals, evs) + | NONE => (types, contexts, actions, s :: vals, evs)) + | DVal (s, NONE, _) => (types, contexts, actions, s :: vals, evs) + | DVal (s, SOME t, _) => + (case isAction evs t of + SOME evs => (types, contexts, s :: actions, vals, evs) + | NONE => (types, contexts, actions, s :: vals, evs)) + | DContext s => (types, s :: contexts, actions, vals, evs)) + acc decls + end + + val (types, contexts, actions, vals, evs) = + foldl doFile ([], [], [], [], StringSet.empty) infiles + + fun printKind (ident, syms) = + (print "(defconst domtool-"; + print ident; + print "-regexp\n (domtool-syms-re"; + app (fn s => (print " \""; print s; print "\"")) syms; + print ")\n \"A regexp that matches Domtool "; + print ident; + print " from the standard library.\")\n\n") + in + printKind ("types", types); + printKind ("contexts", contexts); + printKind ("actions", actions); + printKind ("vals", vals); + printKind ("env-vars", StringSet.listItems evs) + end + end diff --git a/src/main-doc.sml b/src/main-doc.sml index 3df2ad3..f088f8b 100644 --- a/src/main-doc.sml +++ b/src/main-doc.sml @@ -1,5 +1,5 @@ (* HCoop Domtool (http://hcoop.sourceforge.net/) - * Copyright (c) 2006, Adam Chlipala + * Copyright (c) 2006-2007, Adam Chlipala * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License @@ -18,19 +18,25 @@ (* Driver for documentation generation *) -fun processArgs (args, basis, outdir, files) = +fun processArgs (args, basis, outdir, files, emacs) = case args of - [] => (basis, outdir, files) - | "-basis" :: rest => processArgs (rest, true, outdir, files) - | "-out" :: dir :: rest => processArgs (rest, basis, dir, files) - | file :: rest => processArgs (rest, basis, outdir, file :: files) + [] => (basis, outdir, files, emacs) + | "-basis" :: rest => processArgs (rest, true, outdir, files, emacs) + | "-out" :: dir :: rest => processArgs (rest, basis, dir, files, emacs) + | "-emacs" :: rest => processArgs (rest, basis, outdir, files, true) + | file :: rest => + if size file > 0 andalso String.sub (file, 0) <> #"-" then + processArgs (rest, basis, outdir, file :: files, emacs) + else + raise Fail ("Uknown switch " ^ file) val _ = let - val (basis, outdir, files) = processArgs (CommandLine.arguments (), - false, - OS.FileSys.getDir (), - []) + val (basis, outdir, files, emacs) = processArgs (CommandLine.arguments (), + false, + OS.FileSys.getDir (), + [], + false) val files = if basis then Main.listBasis () @ files @@ -38,5 +44,8 @@ val _ = files in Tycheck.allowExterns (); - Autodoc.autodoc {outdir = outdir, infiles = files} + if emacs then + Autodoc.makeEmacsKeywords files + else + Autodoc.autodoc {outdir = outdir, infiles = files} end