| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407 | <!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 type="text/css">.CodeMirror {border-top: 1px solid black; border-bottom: 1px solid black;}</style><div id=nav>  <a href="http://codemirror.net"><h1>CodeMirror</h1><img id=logo src="../../doc/logo.png"></a>  <ul>    <li><a href="../../index.html">Home</a>    <li><a href="../../doc/manual.html">Manual</a>    <li><a href="https://github.com/codemirror/codemirror">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 KINDdefine 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 classesdefine 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 conditionsdefine 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 protocolsdefine 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 locatordefine 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 locatordefine 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 locatordefine 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 locatorsdefine open generic merge-locators    (locator :: <physical-locator>, from-locator :: <physical-locator>) => (merged-locator :: <physical-locator>);/// Merge locatorsdefine 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 protocolsdefine 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>
 |