|
|
<!doctype html>
<title>CodeMirror: Dylan mode</title><meta charset="utf-8"/><link rel=stylesheet href="../../doc/docs.css">
<link rel="stylesheet" href="../../lib/codemirror.css"><script src="../../lib/codemirror.js"></script><script src="../../addon/edit/matchbrackets.js"></script><script src="../../addon/comment/continuecomment.js"></script><script src="../../addon/comment/comment.js"></script><script src="dylan.js"></script><style>.CodeMirror {border-top: 1px solid black; border-bottom: 1px solid black;}</style><div id=nav> <a href="https://codemirror.net/5"><h1>CodeMirror</h1><img id=logo src="../../doc/logo.png" alt=""></a>
<ul> <li><a href="../../index.html">Home</a> <li><a href="../../doc/manual.html">Manual</a> <li><a href="https://github.com/codemirror/codemirror5">Code</a> </ul> <ul> <li><a href="../index.html">Language modes</a> <li><a class=active href="#">Dylan</a> </ul></div>
<article><h2>Dylan mode</h2>
<div><textarea id="code" name="code">Module: locators-internalsSynopsis: Abstract modeling of locationsAuthor: Andy ArmstrongCopyright: Original Code is Copyright (c) 1995-2004 Functional Objects, Inc. All rights reserved.License: See License.txt in this distribution for details.Warranty: Distributed WITHOUT WARRANTY OF ANY KIND
define open generic locator-server (locator :: <locator>) => (server :: false-or(<server-locator>));define open generic locator-host (locator :: <locator>) => (host :: false-or(<string>));define open generic locator-volume (locator :: <locator>) => (volume :: false-or(<string>));define open generic locator-directory (locator :: <locator>) => (directory :: false-or(<directory-locator>));define open generic locator-relative? (locator :: <locator>) => (relative? :: <boolean>);define open generic locator-path (locator :: <locator>) => (path :: <sequence>);define open generic locator-base (locator :: <locator>) => (base :: false-or(<string>));define open generic locator-extension (locator :: <locator>) => (extension :: false-or(<string>));
/// Locator classes
define open abstract class <directory-locator> (<physical-locator>)end class <directory-locator>;
define open abstract class <file-locator> (<physical-locator>)end class <file-locator>;
define method as (class == <directory-locator>, string :: <string>) => (locator :: <directory-locator>) as(<native-directory-locator>, string)end method as;
define method make (class == <directory-locator>, #key server :: false-or(<server-locator>) = #f, path :: <sequence> = #[], relative? :: <boolean> = #f, name :: false-or(<string>) = #f) => (locator :: <directory-locator>) make(<native-directory-locator>, server: server, path: path, relative?: relative?, name: name)end method make;
define method as (class == <file-locator>, string :: <string>) => (locator :: <file-locator>) as(<native-file-locator>, string)end method as;
define method make (class == <file-locator>, #key directory :: false-or(<directory-locator>) = #f, base :: false-or(<string>) = #f, extension :: false-or(<string>) = #f, name :: false-or(<string>) = #f) => (locator :: <file-locator>) make(<native-file-locator>, directory: directory, base: base, extension: extension, name: name)end method make;
/// Locator coercion
//---*** andrewa: This caching scheme doesn't work yet, so disable it.define constant $cache-locators? = #f;define constant $cache-locator-strings? = #f;
define constant $locator-to-string-cache = make(<object-table>, weak: #"key");define constant $string-to-locator-cache = make(<string-table>, weak: #"value");
define open generic locator-as-string (class :: subclass(<string>), locator :: <locator>) => (string :: <string>);
define open generic string-as-locator (class :: subclass(<locator>), string :: <string>) => (locator :: <locator>);
define sealed sideways method as (class :: subclass(<string>), locator :: <locator>) => (string :: <string>) let string = element($locator-to-string-cache, locator, default: #f); if (string) as(class, string) else let string = locator-as-string(class, locator); if ($cache-locator-strings?) element($locator-to-string-cache, locator) := string; else string end endend method as;
define sealed sideways method as (class :: subclass(<locator>), string :: <string>) => (locator :: <locator>) let locator = element($string-to-locator-cache, string, default: #f); if (instance?(locator, class)) locator else let locator = string-as-locator(class, string); if ($cache-locators?) element($string-to-locator-cache, string) := locator; else locator end endend method as;
/// Locator conditions
define class <locator-error> (<format-string-condition>, <error>)end class <locator-error>;
define function locator-error (format-string :: <string>, #rest format-arguments) error(make(<locator-error>, format-string: format-string, format-arguments: format-arguments))end function locator-error;
/// Useful locator protocols
define open generic locator-test (locator :: <directory-locator>) => (test :: <function>);
define method locator-test (locator :: <directory-locator>) => (test :: <function>) \=end method locator-test;
define open generic locator-might-have-links? (locator :: <directory-locator>) => (links? :: <boolean>);
define method locator-might-have-links? (locator :: <directory-locator>) => (links? :: singleton(#f)) #fend method locator-might-have-links?;
define method locator-relative? (locator :: <file-locator>) => (relative? :: <boolean>) let directory = locator.locator-directory; ~directory | directory.locator-relative?end method locator-relative?;
define method current-directory-locator? (locator :: <directory-locator>) => (current-directory? :: <boolean>) locator.locator-relative? & locator.locator-path = #[#"self"]end method current-directory-locator?;
define method locator-directory (locator :: <directory-locator>) => (parent :: false-or(<directory-locator>)) let path = locator.locator-path; unless (empty?(path)) make(object-class(locator), server: locator.locator-server, path: copy-sequence(path, end: path.size - 1), relative?: locator.locator-relative?) endend method locator-directory;
/// Simplify locator
define open generic simplify-locator (locator :: <physical-locator>) => (simplified-locator :: <physical-locator>);
define method simplify-locator (locator :: <directory-locator>) => (simplified-locator :: <directory-locator>) let path = locator.locator-path; let relative? = locator.locator-relative?; let resolve-parent? = ~locator.locator-might-have-links?; let simplified-path = simplify-path(path, resolve-parent?: resolve-parent?, relative?: relative?); if (path ~= simplified-path) make(object-class(locator), server: locator.locator-server, path: simplified-path, relative?: locator.locator-relative?) else locator endend method simplify-locator;
define method simplify-locator (locator :: <file-locator>) => (simplified-locator :: <file-locator>) let directory = locator.locator-directory; let simplified-directory = directory & simplify-locator(directory); if (directory ~= simplified-directory) make(object-class(locator), directory: simplified-directory, base: locator.locator-base, extension: locator.locator-extension) else locator endend method simplify-locator;
/// Subdirectory locator
define open generic subdirectory-locator (locator :: <directory-locator>, #rest sub-path) => (subdirectory :: <directory-locator>);
define method subdirectory-locator (locator :: <directory-locator>, #rest sub-path) => (subdirectory :: <directory-locator>) let old-path = locator.locator-path; let new-path = concatenate-as(<simple-object-vector>, old-path, sub-path); make(object-class(locator), server: locator.locator-server, path: new-path, relative?: locator.locator-relative?)end method subdirectory-locator;
/// Relative locator
define open generic relative-locator (locator :: <physical-locator>, from-locator :: <physical-locator>) => (relative-locator :: <physical-locator>);
define method relative-locator (locator :: <directory-locator>, from-locator :: <directory-locator>) => (relative-locator :: <directory-locator>) let path = locator.locator-path; let from-path = from-locator.locator-path; case ~locator.locator-relative? & from-locator.locator-relative? => locator-error ("Cannot find relative path of absolute locator %= from relative locator %=", locator, from-locator); locator.locator-server ~= from-locator.locator-server => locator; path = from-path => make(object-class(locator), path: vector(#"self"), relative?: #t); otherwise => make(object-class(locator), path: relative-path(path, from-path, test: locator.locator-test), relative?: #t); endend method relative-locator;
define method relative-locator (locator :: <file-locator>, from-directory :: <directory-locator>) => (relative-locator :: <file-locator>) let directory = locator.locator-directory; let relative-directory = directory & relative-locator(directory, from-directory); if (relative-directory ~= directory) simplify-locator (make(object-class(locator), directory: relative-directory, base: locator.locator-base, extension: locator.locator-extension)) else locator endend method relative-locator;
define method relative-locator (locator :: <physical-locator>, from-locator :: <file-locator>) => (relative-locator :: <physical-locator>) let from-directory = from-locator.locator-directory; case from-directory => relative-locator(locator, from-directory); ~locator.locator-relative? => locator-error ("Cannot find relative path of absolute locator %= from relative locator %=", locator, from-locator); otherwise => locator; endend method relative-locator;
/// Merge locators
define open generic merge-locators (locator :: <physical-locator>, from-locator :: <physical-locator>) => (merged-locator :: <physical-locator>);
/// Merge locators
define method merge-locators (locator :: <directory-locator>, from-locator :: <directory-locator>) => (merged-locator :: <directory-locator>) if (locator.locator-relative?) let path = concatenate(from-locator.locator-path, locator.locator-path); simplify-locator (make(object-class(locator), server: from-locator.locator-server, path: path, relative?: from-locator.locator-relative?)) else locator endend method merge-locators;
define method merge-locators (locator :: <file-locator>, from-locator :: <directory-locator>) => (merged-locator :: <file-locator>) let directory = locator.locator-directory; let merged-directory = if (directory) merge-locators(directory, from-locator) else simplify-locator(from-locator) end; if (merged-directory ~= directory) make(object-class(locator), directory: merged-directory, base: locator.locator-base, extension: locator.locator-extension) else locator endend method merge-locators;
define method merge-locators (locator :: <physical-locator>, from-locator :: <file-locator>) => (merged-locator :: <physical-locator>) let from-directory = from-locator.locator-directory; if (from-directory) merge-locators(locator, from-directory) else locator endend method merge-locators;
/// Locator protocols
define sideways method supports-open-locator? (locator :: <file-locator>) => (openable? :: <boolean>) ~locator.locator-relative?end method supports-open-locator?;
define sideways method open-locator (locator :: <file-locator>, #rest keywords, #key, #all-keys) => (stream :: <stream>) apply(open-file-stream, locator, keywords)end method open-locator;</textarea></div>
<script> var editor = CodeMirror.fromTextArea(document.getElementById("code"), { mode: "text/x-dylan", lineNumbers: true, matchBrackets: true, continueComments: "Enter", extraKeys: {"Ctrl-Q": "toggleComment"}, tabMode: "indent", indentUnit: 2 }); </script>
<p><strong>MIME types defined:</strong> <code>text/x-dylan</code>.</p></article>
|
