Merge branch 'master' into objc-mercury

.gitmodules

@@ -121,9 +121,9 @@
 [submodule "vendor/grammars/Handlebars"]
 	path = vendor/grammars/Handlebars
 	url = https://github.com/daaain/Handlebars
-[submodule "vendor/grammars/powershell.tmbundle"]
+[submodule "vendor/grammars/powershell"]
-	path = vendor/grammars/powershell.tmbundle
+	path = vendor/grammars/powershell
-	url = https://github.com/davidpeckham/powershell.tmbundle
+	url = https://github.com/SublimeText/PowerShell
 [submodule "vendor/grammars/jade-tmbundle"]
 	path = vendor/grammars/jade-tmbundle
 	url = https://github.com/davidrios/jade-tmbundle
@@ -549,3 +549,6 @@
 [submodule "vendor/grammars/turtle.tmbundle"]
 	path = vendor/grammars/turtle.tmbundle
 	url = https://github.com/peta/turtle.tmbundle
+[submodule "vendor/grammars/liquid.tmbundle"]
+	path = vendor/grammars/liquid.tmbundle
+	url = https://github.com/bastilian/validcode-textmate-bundles

LICENSE

@@ -1,4 +1,4 @@
-Copyright (c) 2011-2014 GitHub, Inc.
+Copyright (c) 2011-2015 GitHub, Inc.
 
 Permission is hereby granted, free of charge, to any person
 obtaining a copy of this software and associated documentation

grammars.yml

@@ -289,6 +289,8 @@ vendor/grammars/less.tmbundle:
 - source.css.less
 vendor/grammars/lilypond.tmbundle:
 - source.lilypond
+vendor/grammars/liquid.tmbundle:
+- text.html.liquid
 vendor/grammars/lisp.tmbundle:
 - source.lisp
 vendor/grammars/llvm.tmbundle:
@@ -348,7 +350,7 @@ vendor/grammars/pike-textmate:
 - source.pike
 vendor/grammars/postscript.tmbundle:
 - source.postscript
-vendor/grammars/powershell.tmbundle:
+vendor/grammars/powershell:
 - source.powershell
 vendor/grammars/processing.tmbundle:
 - source.processing

lib/linguist/heuristics.rb

@@ -112,6 +112,15 @@ module Linguist
       end
     end
 
+    disambiguate "GAP", "Scilab" do |data|
+      if (data.include?("gap> "))
+        Language["GAP"]
+      # Heads up - we don't usually write heuristics like this (with no regex match)
+      else
+        Language["Scilab"]
+      end
+    end
+
     disambiguate "Common Lisp", "OpenCL", "Cool" do |data|
       if data.include?("(defun ")
         Language["Common Lisp"]
@@ -186,6 +195,14 @@ module Linguist
       end
     end
 
+    disambiguate "Common Lisp", "NewLisp" do |data|
+      if /^\s*\((defun|in-package|defpackage) /.match(data)
+        Language["Common Lisp"]
+      elsif /^\s*\(define /.match(data)
+        Language["NewLisp"]
+      end
+    end
+
     disambiguate "TypeScript", "XML" do |data|
       if data.include?("<TS ")
         Language["XML"]

lib/linguist/language.rb

@@ -155,7 +155,7 @@ module Linguist
     #   Language.find_by_alias('cpp')
     #   # => #<Language name="C++">
     #
-    # Returns the Lexer or nil if none was found.
+    # Returns the Language or nil if none was found.
     def self.find_by_alias(name)
       name && @alias_index[name.downcase]
     end
@@ -219,7 +219,7 @@ module Linguist
     end
 
 
-    # Public: Look up Language by its name or lexer.
+    # Public: Look up Language by its name.
     #
     # name - The String name of the Language
     #
@@ -243,7 +243,7 @@ module Linguist
     #
     # This list is configured in "popular.yml".
     #
-    # Returns an Array of Lexers.
+    # Returns an Array of Languages.
     def self.popular
       @popular ||= all.select(&:popular?).sort_by { |lang| lang.name.downcase }
     end
@@ -255,7 +255,7 @@ module Linguist
     #
     # This list is created from all the languages not listed in "popular.yml".
     #
-    # Returns an Array of Lexers.
+    # Returns an Array of Languages.
     def self.unpopular
       @unpopular ||= all.select(&:unpopular?).sort_by { |lang| lang.name.downcase }
     end
@@ -375,11 +375,6 @@ module Linguist
     # Returns the name String
     attr_reader :search_term
 
-    # Public: Get Lexer
-    #
-    # Returns the Lexer
-    attr_reader :lexer
-
     # Public: Get the name of a TextMate-compatible scope
     #
     # Returns the scope
@@ -495,16 +490,6 @@ module Linguist
       @searchable
     end
 
-    # Public: Highlight syntax of text
-    #
-    # text    - String of code to be highlighted
-    # options - A Hash of options (defaults to {})
-    #
-    # Returns html String
-    def colorize(text, options = {})
-      lexer.highlight(text, options)
-    end
-
     # Public: Return name as String representation
     def to_s
       name
@@ -580,7 +565,6 @@ module Linguist
       :color             => options['color'],
       :type              => options['type'],
       :aliases           => options['aliases'],
-      :lexer             => options['lexer'],
       :tm_scope          => options['tm_scope'],
       :ace_mode          => options['ace_mode'],
       :wrap              => options['wrap'],

lib/linguist/languages.yml

@@ -61,6 +61,7 @@ ASP:
   type: programming
   color: "#6a40fd"
   search_term: aspx-vb
+  tm_scope: text.html.asp
   aliases:
   - aspx
   - aspx-vb
@@ -956,6 +957,7 @@ GAP:
   - .gap
   - .gd
   - .gi
+  - .tst
   tm_scope: none
   ace_mode: text
 
@@ -1596,7 +1598,7 @@ Liquid:
   type: markup
   extensions:
   - .liquid
-  tm_scope: none
+  tm_scope: text.html.liquid
   ace_mode: liquid
 
 Literate Agda:
@@ -1883,6 +1885,19 @@ NetLogo:
   tm_scope: source.lisp
   ace_mode: lisp
 
+NewLisp:
+  type: programming
+  lexer: NewLisp
+  color: "#eedd66"
+  extensions:
+  - .nl
+  - .lisp
+  - .lsp
+  interpreters:
+  - newlisp
+  tm_scope: source.lisp
+  ace_mode: lisp
+
 Nginx:
   type: markup
   extensions:
@@ -2055,7 +2070,7 @@ OpenSCAD:
   extensions:
   - .scad
   tm_scope: none
-  ace_mode: text
+  ace_mode: scad
 
 Org:
   type: prose
@@ -2426,7 +2441,6 @@ R:
 
 RAML:
   type: data
-  lexer: YAML
   ace_mode: yaml
   tm_scope: source.yaml
   color: "#77d9fb"

lib/linguist/tokenizer.rb

@@ -33,7 +33,8 @@ module Linguist
       ['<!--', '-->'], # XML
       ['{-', '-}'],    # Haskell
       ['(*', '*)'],    # Coq
-      ['"""', '"""']   # Python
+      ['"""', '"""'],  # Python
+      ["'''", "'''"]   # Python
     ]
 
     START_SINGLE_LINE_COMMENT =  Regexp.compile(SINGLE_LINE_COMMENTS.map { |c|

samples/Common Lisp/sample.lsp

@@ -0,0 +1,21 @@
+;;;; -*- lisp -*-
+
+(in-package :foo)
+
+;;; Header comment.
+(defvar *foo*)
+
+(eval-when (:execute :compile-toplevel :load-toplevel)
+  (defun add (x &optional y &key z)
+    (declare (ignore z))
+    ;; Inline comment.
+    (+ x (or y 1))))
+
+#|
+Multi-line comment.
+|#
+
+(defmacro foo (x &body b)
+  (if x
+      `(1+ ,x)   ;After-line comment.
+      42))

samples/GAP/bugfix.tst

@@ -0,0 +1,161 @@
+gap> START_TEST("Test for various former bugs");
+
+
+gap> # The following used to trigger an error starting with:
+gap> # "SolutionMat: matrix and vector incompatible called from"
+gap> K:=AbelianPcpGroup([3,3,3]);;
+gap> A:=Subgroup(K,[K.1]);;
+gap> cr:=CRRecordBySubgroup(K,A);;
+gap> ExtensionsCR(cr);;
+
+
+# Comparing homomorphisms used to be broken
+gap> K:=AbelianPcpGroup(1,[3]);;
+gap> hom1:=GroupHomomorphismByImages(K,K,[K.1],[K.1]);;
+gap> hom2:=GroupHomomorphismByImages(K,K,[K.1^2],[K.1^2]);;
+gap> hom1=hom2;
+true
+gap> hom1=IdentityMapping(K);
+true
+gap> hom2=IdentityMapping(K);
+true
+
+
+gap> # The following incorrectly triggered an error at some point
+gap> IsTorsionFree(ExamplesOfSomePcpGroups(5));
+true
+
+
+gap> # Verify IsGeneratorsOfMagmaWithInverses warnings are silenced
+gap> IsGeneratorsOfMagmaWithInverses(GeneratorsOfGroup(ExamplesOfSomePcpGroups(5)));
+true
+
+
+gap> # Check for a bug reported 2012-01-19 by Robert Morse
+gap> g := PcGroupToPcpGroup(SmallGroup(48,1));
+Pcp-group with orders [ 2, 2, 2, 2, 3 ]
+gap> # The next two commands used to trigger errors
+gap> NonAbelianTensorSquare(Centre(g));
+Pcp-group with orders [ 8 ]
+gap> NonAbelianExteriorSquare(Centre(g));
+Pcp-group with orders [  ]
+
+
+gap> # Check for a bug reported 2012-01-19 by Robert Morse
+gap> F := FreeGroup("x","y");
+<free group on the generators [ x, y ]>
+gap> x := F.1;; y := F.2;;
+gap> G := F/[x^2/y^24, y^24, y^x/y^23];
+<fp group on the generators [ x, y ]>
+gap> iso := IsomorphismPcGroup(G);
+[ x, y ] -> [ f1, f2*f5 ]
+gap> iso1 := IsomorphismPcpGroup(Image(iso));
+[ f1, f2, f3, f4, f5 ] -> [ g1, g2, g3, g4, g5 ]
+gap> G := Image(iso*iso1);
+Pcp-group with orders [ 2, 2, 2, 2, 3 ]
+gap> # The next command used to trigger an error
+gap> NonAbelianTensorSquare(Image(iso*iso1));
+Pcp-group with orders [ 2, 2, 3, 2, 2, 2, 2 ]
+
+
+gap> # The problem with the previous example is/was that Igs(G)
+gap> # is set to a non-standard value:
+gap> Igs(G);
+[ g1, g2*g5, g3*g4*g5^2, g4*g5, g5 ]
+gap> # Unfortunately, it seems that a lot of code that
+gap> # really should be using Ngs or Cgs is using Igs incorrectly.
+gap> # For example, direct products could return *invalid* embeddings:
+gap> D := DirectProduct(G, G);
+Pcp-group with orders [ 2, 2, 2, 2, 3, 2, 2, 2, 2, 3 ]
+gap> hom:=Embedding(D,1);;
+gap> mapi:=MappingGeneratorsImages(hom);;
+gap> GroupHomomorphismByImages(Source(hom),Range(hom),mapi[1],mapi[2]) <> fail;
+true
+gap> hom:=Projection(D,1);;
+gap> mapi:=MappingGeneratorsImages(hom);;
+gap> GroupHomomorphismByImages(Source(hom),Range(hom),mapi[1],mapi[2]) <> fail;
+true
+
+
+gap> # Check for bug computing Schur extension of infinite cyclic groups,
+gap> # found by Max Horn 2012-05-25
+gap> G:=AbelianPcpGroup(1,[0]);
+Pcp-group with orders [ 0 ]
+gap> # The next command used to trigger an error
+gap> SchurExtension(G);
+Pcp-group with orders [ 0 ]
+
+
+gap> # Check for bug computing Schur extensions of subgroups, found by MH 2012-05-25.
+gap> G:=HeisenbergPcpGroup(2);
+Pcp-group with orders [ 0, 0, 0, 0, 0 ]
+gap> H:=Subgroup(G,[G.2^3*G.3^2, G.1^9]);
+Pcp-group with orders [ 0, 0, 0 ]
+gap> # The next command used to trigger an error
+gap> SchurExtension(H);
+Pcp-group with orders [ 0, 0, 0, 0, 0, 0 ]
+
+
+gap> # Check for bug computing Schur extensions of subgroups, found by MH 2012-05-25.
+gap> G:=HeisenbergPcpGroup(2);
+Pcp-group with orders [ 0, 0, 0, 0, 0 ]
+gap> H:=Subgroup(G,[G.1, G.2]);
+Pcp-group with orders [ 0, 0 ]
+gap> # The next command used to trigger an error
+gap> SchurExtension(H);
+Pcp-group with orders [ 0, 0, 0 ]
+
+
+gap> # Check for bug computing normalizer of two subgroups, found by MH 2012-05-30.
+gap> # The problem was caused by incorrect resp. overly restrictive use of Parent().
+gap> G:=HeisenbergPcpGroup(2);
+Pcp-group with orders [ 0, 0, 0, 0, 0 ]
+gap> A:=Subgroup(Subgroup(G,[G.2,G.3,G.4,G.5]), [G.3]);
+Pcp-group with orders [ 0 ]
+gap> B:=Subgroup(Subgroup(G,[G.1,G.4,G.5]), [G.4]);
+Pcp-group with orders [ 0 ]
+gap> Normalizer(A,B);
+Pcp-group with orders [ 0 ]
+gap> # The following used to trigger the error "arguments must have a common parent group"
+gap> Normalizer(B,A);
+Pcp-group with orders [ 0 ]
+
+
+gap> # In polycyclic 2.9 and 2.10, the code for 2-cohomology computations was broken.
+gap> G := UnitriangularPcpGroup(3,0);
+Pcp-group with orders [ 0, 0, 0 ]
+gap> mats := G!.mats;
+[ [ [ 1, 1, 0 ], [ 0, 1, 0 ], [ 0, 0, 1 ] ], 
+  [ [ 1, 0, 0 ], [ 0, 1, 1 ], [ 0, 0, 1 ] ], 
+  [ [ 1, 0, 1 ], [ 0, 1, 0 ], [ 0, 0, 1 ] ] ]
+gap> C := CRRecordByMats(G,mats);;
+gap> cc := TwoCohomologyCR(C);;
+gap> cc.factor.rels;
+[ 2, 0, 0 ]
+gap> c := cc.factor.prei[2];
+[ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, -1, 1 ]
+gap> cc.gcb;
+[ [ 0, 0, 1, 0, 0, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ], 
+  [ 0, 0, -1, 0, 0, 0, 0, 0, 1, 0, 0, -1, 0, 0, 0, 0, 0, 0 ], 
+  [ 0, -1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, -1 ], 
+  [ -1, 0, 1, 1, 0, 0, 0, -1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0 ], 
+  [ 0, -1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, -1, 0, 0, 1 ] ]
+gap> cc.gcc;
+[ [ 1, 0, 0, 0, 0, -2, -1, 0, 1, 1, -1, -1, 0, 0, 0, 0, 0, 0 ], 
+  [ 0, 1, 0, 0, -1, -1, 0, 0, 1, 0, 0, -1, 0, 0, 0, 0, 0, 0 ], 
+  [ 0, 0, 1, 0, 0, -2, 0, 0, 1, 0, 0, -1, 0, 0, 0, 0, 0, 0 ], 
+  [ 0, 0, 0, 1, 0, 0, -1, -1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0 ], 
+  [ 0, 0, 0, 0, 0, 1, 0, 0, -1, 0, 0, 1, 0, 0, 0, 0, 0, 0 ], 
+  [ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, -1, 1 ], 
+  [ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, -1 ] ]
+
+
+gap> # LowerCentralSeriesOfGroup for non-nilpotent pcp-groups used to trigger
+gap> # an infinite recursion
+gap> G := PcGroupToPcpGroup(SmallGroup(6,1));
+Pcp-group with orders [ 2, 3 ]
+gap> LowerCentralSeriesOfGroup(G);
+[ Pcp-group with orders [ 2, 3 ], Pcp-group with orders [ 3 ] ]
+
+
+gap> STOP_TEST( "bugfix.tst", 10000000);

samples/GAP/factor.tst

@@ -0,0 +1,21 @@
+gap> START_TEST("Test of factor groups and natural homomorphisms");
+
+gap> G:=HeisenbergPcpGroup(2);
+Pcp-group with orders [ 0, 0, 0, 0, 0 ]
+
+gap> H:=Subgroup(G,[G.2,G.3,G.4,G.5]);
+gap> K:=G/H;
+gap> NaturalHomomorphism(K);
+
+gap> A:=Subgroup(H, [G.3]);
+Pcp-group with orders [ 0 ]
+gap> B:=Subgroup(Subgroup(G,[G.1,G.4,G.5]), [G.4]);
+Pcp-group with orders [ 0 ]
+gap> Normalizer(A,B);
+Pcp-group with orders [ 0 ]
+gap> # The following used to trigger the error "arguments must have a common parent group"
+gap> Normalizer(B,A);
+Pcp-group with orders [ 0 ]
+
+
+gap> STOP_TEST( "factor.tst", 10000000);

samples/NewLisp/irc.lsp

@@ -0,0 +1,239 @@
+#!/usr/bin/env newlisp
+
+;; @module IRC
+;; @description a basic irc library
+;; @version early alpha! 0.1 2013-01-02 20:11:22
+;; @author cormullion
+;; Usage:
+;; (IRC:init "newlithper") ; a username/nick (not that one obviously :-)
+;; (IRC:connect "irc.freenode.net" 6667) ; irc/server
+;; (IRC:join-channel {#newlisp}) ; join a room
+;; either (IRC:read-irc-loop) ; loop - monitor only, no input
+;; or     (IRC:session)       ; a command-line session, end with /QUIT
+
+(context 'IRC)
+    (define Inickname)
+    (define Ichannels)
+    (define Iserver)
+    (define Iconnected)
+    (define Icallbacks '())
+    (define Idle-time 400) ; seconds
+    (define Itime-stamp)   ; time since last message was processed
+
+(define (register-callback callback-name callback-function)
+    (println {registering callback for } callback-name { : } (sym (term callback-function) (prefix callback-function)))
+    (push (list callback-name (sym (term callback-function) (prefix callback-function))) Icallbacks)) 
+
+(define (deregister-callback callback-name)
+    (println {deregistering callback for } callback-name)
+    (setf (assoc "idle-event" Icallbacks) nil)
+    (println {current callbacks: } Icallbacks)) 
+
+(define (do-callback callback-name data)
+   (when (set 'func (lookup callback-name Icallbacks)) ; find first callback
+         (if-not (catch (apply func (list data)) 'error)
+                 (println {error in callback } callback-name {: } error))))
+
+(define (do-callbacks callback-name data)
+   (dolist (rf (ref-all callback-name Icallbacks))
+        (set 'callback-entry (Icallbacks (first rf)))
+        (when   (set 'func (last callback-entry))
+                (if-not (catch (apply func (list data)) 'error)
+                (println {error in callback } callback-name {: } error)))))
+
+(define (init str)
+   (set 'Inickname str)
+   (set 'Iconnected nil)
+   (set 'Ichannels '())
+   (set 'Itime-stamp (time-of-day)))
+
+(define (connect server port)
+    (set 'Iserver     (net-connect server port))
+    (net-send Iserver (format "USER %s %s %s :%s\r\n" Inickname Inickname Inickname Inickname))
+    (net-send Iserver (format "NICK %s \r\n" Inickname))
+    (set 'Iconnected true)
+    (do-callbacks "connect" (list (list "server" server) (list "port" port))))
+
+(define (identify password)
+    (net-send Iserver (format "PRIVMSG nickserv :identify %s\r\n" password)))
+
+(define (join-channel channel)
+    (when (net-send Iserver (format "JOIN %s \r\n" channel))
+          (push channel Ichannels)
+          (do-callbacks "join-channel" (list (list "channel" channel) (list "nickname" Inickname)))))
+
+(define (part chan)
+    (if-not (empty? chan)
+        ; leave specified
+        (begin
+            (net-send Iserver (format "PART %s\r\n" chan))
+            (replace channel Ichannels)
+            (do-callbacks "part" (list (list "channel" channel))))
+        ; leave all
+        (begin
+            (dolist (channel Ichannels)
+                (net-send Iserver (format "PART %s\r\n" channel))
+                (replace channel Ichannels)
+                (do-callbacks "part" (list (list "channel" channel)))))))
+
+(define (do-quit message)
+    (do-callbacks "quit" '()) ; chance to do stuff before quit...
+    (net-send Iserver (format "QUIT :%s\r\n" message))
+    (sleep 1000)
+    (set 'Ichannels '())
+    (close Iserver)
+    (set 'Iconnected nil))
+
+(define (privmsg user message)
+    (net-send Iserver (format "PRIVMSG %s :%s\r\n" user message)))
+
+(define (notice user message)
+    (net-send Iserver (format "NOTICE %s :%s\r\n" user message)))
+
+(define (send-to-server message (channel nil))
+    (cond
+        ((starts-with message {/}) ; default command character
+            (set 'the-message (replace "^/" (copy message) {} 0)) ; keep original
+            (net-send Iserver (format "%s \r\n" the-message)) ; send it
+            ; do a quit
+            (if (starts-with (lower-case the-message) "quit")
+                (do-quit { enough})))
+        (true 
+            (if (nil? channel)
+                ; say to all channels
+                (dolist (c Ichannels)
+                        (net-send Iserver (format "PRIVMSG %s :%s\r\n" c message)))
+                ; say to specified channel
+                (if (find channel Ichannels)
+                    (net-send Iserver (format "PRIVMSG %s :%s\r\n" channel message))))))
+    (do-callbacks "send-to-server" (list (list "channel" channel) (list "message" message))))
+
+(define (process-command sender command text)
+    (cond
+        ((= sender "PING")
+            (net-send Iserver (format "PONG %s\r\n" command)))
+        ((or (= command "NOTICE") (= command "PRIVMSG"))
+            (process-message sender command text))
+        ((= command "JOIN")
+            (set 'username (first (clean empty? (parse sender {!|:} 0))))
+            (set 'channel  (last  (clean empty? (parse sender {!|:} 0))))
+            (println {username } username { joined } channel)
+            (do-callbacks "join" (list (list "channel" channel) (list "username" username))))
+        (true
+            nil)))
+
+(define (process-message sender command text)
+    (let ((username {} target {} message {}))
+        (set 'username (first (clean empty? (parse sender {!|:} 0))))
+        (set 'target   (trim  (first (clean empty? (parse text {!|:} 0)))))
+        (set 'message  (slice text (+ (find {:} text) 1)))
+        (cond 
+            ((starts-with message "\001")
+                (process-ctcp username target message))
+            ((find target Ichannels)
+                (cond 
+                    ((= command {PRIVMSG})
+                        (do-callbacks "channel-message" (list (list "channel" target) (list "username" username) (list "message" message))))
+                    ((= command {NOTICE})
+                        (do-callbacks "channel-notice"  (list (list "channel" target) (list "username" username) (list "message" message))))))
+            ((= target Inickname)
+                (cond 
+                    ((= command {PRIVMSG})
+                        (do-callbacks "private-message" (list (list "username" username) (list "message" message))))
+                    ((= command {NOTICE})
+                        (do-callbacks "private-notice"  (list (list "username" username) (list "message" message))))))
+            (true                
+                nil))))
+  
+(define (process-ctcp username target message)
+    (cond
+        ((starts-with message "\001VERSION\001")
+            (net-send Iserver (format "NOTICE %s :\001VERSION %s\001\r\n" username message)))
+        ((starts-with message "\001PING")
+            (set 'data (first (rest (clean empty? (parse message { } 0)))))
+            (set 'data (trim data "\001" "\001"))
+            (net-send Iserver  (format "NOTICE %s :\001PING %s\001\r\n" username data)))
+        ((starts-with message "\001ACTION")
+;            (set 'data (first (rest (clean empty? (parse message { } 0)))))
+;            (set 'data (join data { }))
+;            (set 'data (trim data "\001" "\001"))
+            (if (find target Ichannels)
+                (do-callbacks "channel-action" (list (list "username" username) (list "message" message))))
+            (if (= target Inickname)
+                (do-callbacks "private-action" (list (list "username" username) (list "message" message)))))
+        ((starts-with message "\001TIME\001")
+            (net-send Iserver (format "NOTICE %s:\001TIME :%s\001\r\n" username (date))))))
+
+(define (parse-buffer raw-buffer)
+    (let ((messages (clean empty? (parse raw-buffer "\r\n" 0)))
+          (sender {} command {} text {}))
+        ; check for elapsed time since last activity    
+        (when (> (sub (time-of-day) Itime-stamp) (mul Idle-time 1000))
+              (do-callbacks "idle-event")
+              (set 'Itime-stamp (time-of-day)))
+        (dolist (message messages)
+            (set 'message-parts (parse message { }))           
+            (unless (empty? message-parts)
+                (set 'sender (first message-parts))
+                (catch (set 'command (first (rest message-parts))) 'error)
+                (catch (set 'text (join (rest (rest message-parts)) { })) 'error))
+            (process-command sender command text))))
+
+(define (read-irc)
+    (let ((buffer {}))
+        (when (!= (net-peek Iserver) 0) 
+              (net-receive Iserver buffer 8192 "\n")
+              (unless (empty? buffer)
+                (parse-buffer buffer)))))
+
+(define (read-irc-loop) ; monitoring
+    (let ((buffer {}))       
+        (while Iconnected    
+            (read-irc)
+            (sleep 1000))))
+
+(define (print-raw-message data) ; example of using a callback
+    (set 'raw-data (lookup "message" data))
+    (set 'channel  (lookup "channel" data))
+    (set 'message-text raw-data)
+    (println (date (date-value) 0 {%H:%M:%S }) username {> } message-text))
+
+(define (print-outgoing-message data)
+    (set 'raw-data (lookup "message" data))
+    (set 'channel  (lookup "channel" data))
+    (set 'message-text raw-data)
+    (println (date (date-value) 0 {%H:%M:%S }) Inickname {> } message-text))
+
+(define (session); interactive terminal
+    ; must add callbacks to display messages
+    (register-callback "channel-message" 'print-raw-message)
+    (register-callback "send-to-server"  'print-outgoing-message)
+    (while Iconnected
+        (while (zero? (peek 0))
+            (read-irc)
+            (sleep 1000))
+        (send-to-server (string (read-line 0))))
+    (println {finished session } (date))
+    (exit))
+
+; end of IRC code
+
+[text]
+
+simple bot code:
+(load (string (env {HOME}) {/projects/programming/newlisp-projects/irc.lsp}))
+(context 'BOT)
+(define bot-name "bot")
+(define (join-channel data)
+		(println {in BOT:join-channel with data: } data))
+(define (process-message data)
+        ????)
+(IRC:register-callback "join-channel"    'join-channel) 
+(IRC:register-callback "channel-message" 'process-message)
+(IRC:register-callback "idle-event"      'do-idle-event)
+(IRC:register-callback "send-to-server"  'do-send-event)
+(IRC:init bot-name)
+(IRC:connect "irc.freenode.net" 6667)
+(IRC:join-channel {#newlisp})
+(IRC:read-irc-loop)
+[/text]

samples/NewLisp/log-to-database.lisp

@@ -0,0 +1,195 @@
+(module "sqlite3.lsp") ; loads the SQLite3 database module
+
+; FUNCTIONS-------------------------------------------------
+
+(define (displayln str-to-display)
+ 	(println str-to-display)	
+)
+
+(define (open-database sql-db-to-open)
+	(if (sql3:open (string sql-db-to-open ".db"))  
+		(displayln "")
+		(displayln "There was a problem opening the database " sql-db-to-open ": " (sql3:error))))
+
+(define (close-database)
+	(if (sql3:close)
+		(displayln "")
+		(displayln "There was a problem closing the database: " (sql3:error))))
+
+;====== SAFE-FOR-SQL ===============================================================
+; this function makes strings safe for inserting into SQL statements
+; to avoid SQL injection issues
+; it's simple right now but will add to it later
+;===================================================================================
+(define (safe-for-sql str-sql-query)
+	(if (string? str-sql-query) (begin
+		(replace "&" str-sql-query "&")
+		(replace "'" str-sql-query "'")
+		(replace "\"" str-sql-query """)
+		))
+		(set 'result str-sql-query))
+
+(define (query sql-text)
+ (set 'sqlarray (sql3:sql sql-text))    ; results of query
+ (if sqlarray
+   (setq query-return sqlarray)
+		(if (sql3:error)
+			(displayln (sql3:error) " query problem ")
+			(setq query-return nil))))
+
+(define-macro (create-record)
+	; first save the values
+	(set 'temp-record-values nil)
+	(set 'temp-table-name (first (args)))
+	;(displayln "<BR>Arguments: " (args))
+	(dolist (s (rest (args))) (push (eval s) temp-record-values -1))
+	; now save the arguments as symbols under the context "DB"
+	(dolist (s (rest (args)))
+		(set 'temp-index-num (string $idx)) ; we need to number the symbols to keep them in the correct order
+		(if (= (length temp-index-num) 1) (set 'temp-index-num (string "0" temp-index-num))) ; leading 0 keeps the max at 100.
+		(sym (string temp-index-num s) 'DB))
+	; now create the sql query 
+	(set 'temp-sql-query (string "INSERT INTO " temp-table-name " ("))
+	;(displayln "<P>TABLE NAME: " temp-table-name)
+	;(displayln "<P>SYMBOLS: " (symbols DB))
+	;(displayln "<BR>VALUES: " temp-record-values)
+	(dolist (d (symbols DB)) (extend temp-sql-query (rest (rest (rest (rest (rest (string d)))))) ", "))
+	(set 'temp-sql-query (chop (chop temp-sql-query)))
+	(extend temp-sql-query ") VALUES (")
+	(dolist (q temp-record-values)
+		(if (string? q) (extend temp-sql-query "'")) ; only quote if value is non-numeric
+		(extend temp-sql-query (string (safe-for-sql q)))
+		(if (string? q) (extend temp-sql-query "'")) ; close quote if value is non-numeric
+		(extend temp-sql-query ", ")) ; all values are sanitized to avoid SQL injection
+	(set 'temp-sql-query (chop (chop temp-sql-query)))
+	(extend temp-sql-query ");")
+	;(displayln "<p>***** SQL QUERY: " temp-sql-query)
+	(displayln (query temp-sql-query)) ; actually run the query against the database
+	(delete 'DB) ; we're done, so delete all symbols in the DB context.
+)	
+
+(define-macro (update-record)
+	; first save the values
+	(set 'temp-record-values nil)
+	(set 'temp-table-name (first (args)))
+	(set 'continue true) ; debugging
+	(dolist (s (rest (args))) (push (eval s) temp-record-values -1))
+	; now save the arguments as symbols under the context "D2"
+	(dolist (st (rest (args)))
+		(set 'temp-index-num (string $idx)) ; we need to number the symbols to keep them in the correct order
+		(if (= (length temp-index-num) 1) (set 'temp-index-num (string "0" temp-index-num))) ; leading 0 keeps the max at 100.
+		;(displayln "<br>SYMBOL>>>>" (string temp-index-num st) "<<<") ; debugging
+		(sym (string temp-index-num st) 'D2)
+	)
+	(if continue (begin ; --- temporary debugging
+	; now create the sql query 
+	(set 'temp-sql-query (string "UPDATE " temp-table-name " SET "))
+	;(displayln "<P>TABLE NAME: " temp-table-name)
+	;(displayln "<P>SYMBOLS: " (symbols D2))
+	;(displayln "<BR>VALUES: " temp-record-values)
+	(dolist (d (rest (symbols D2))) ; ignore the first argument, as it will be the ConditionColumn for later
+		(extend temp-sql-query (rest (rest (rest (rest (rest (string d)))))) "=")
+		(set 'q (temp-record-values (+ $idx 1)))
+		(if (string? q) (extend temp-sql-query "'")) ; only quote if value is non-numeric
+		(extend temp-sql-query (string (safe-for-sql q)))
+		(if (string? q) (extend temp-sql-query "'")) ; close quote if value is non-numeric
+		(extend temp-sql-query ", ") ; all values are sanitized to avoid SQL injection
+	)	
+	(set 'temp-sql-query (chop (chop temp-sql-query)))
+	; okay now add the ConditionColumn value
+	(extend temp-sql-query (string " WHERE " (rest (rest (rest (rest (rest (string (first (symbols D2)))))))) "="))
+	(if (string? (first temp-record-values)) (extend temp-sql-query "'"))
+	(extend temp-sql-query (string (safe-for-sql (first temp-record-values))))
+	(if (string? (first temp-record-values)) (extend temp-sql-query "'"))
+	(extend temp-sql-query ";")
+	;(displayln "<p>***** SQL QUERY: " temp-sql-query)
+	(query temp-sql-query) ; actually run the query against the database
+	(delete 'D2) ; we're done, so delete all symbols in the DB context.
+	)) ; --- end temporary debugging
+)	
+
+(define-macro (delete-record)
+	(set 'temp-table-name (first (args)))
+	(set 'temp-record-values nil)
+	(dolist (s (rest (args))) (push (eval s) temp-record-values -1)) ; only one value for NOW...
+	(sym (first (rest (args))) 'DB) ; put the second argument (for now) into a symbol in the DB context
+												; this will have to be in a dolist loop of (rest (args)) when I add more
+	(set 'temp-sql-query (string "DELETE FROM " temp-table-name " WHERE "))
+	(dolist (d (symbols DB)) (extend temp-sql-query (rest (rest (rest (string d))))))
+	(extend temp-sql-query "=")
+	; why am I doing a loop here?  There should be only one value, right?  But maybe for future extension...
+	(dolist (q temp-record-values)
+		(if (string? q) (extend temp-sql-query "'")) ; only quote if value is non-numeric
+		(extend temp-sql-query (string (safe-for-sql q)))
+		(if (string? q) (extend temp-sql-query "'"))) ; close quote if value is non-numeric
+	(extend temp-sql-query ";")
+	;(displayln "TEMP-DELETE-QUERY: " temp-sql-query)	
+	(query temp-sql-query)
+	(delete 'DB) ; we're done, so delete all symbols in the DB context.
+)
+
+(define-macro (get-record)
+	(set 'temp-table-name (first (args)))
+	; if you have more arguments than just the table name, they become the elements of the WHERE clause
+	(if (> (length (args)) 1) (begin
+		(set 'temp-record-values nil)
+		(dolist (s (rest (args))) (push (eval s) temp-record-values -1)) ; only one value for NOW...
+		(sym (first (rest (args))) 'DB) ; put the second argument (for now) into a symbol in the DB context
+													; this will have to be in a dolist loop of (rest (args)) when I add more
+		(set 'temp-sql-query (string "SELECT * FROM " temp-table-name " WHERE "))
+		(dolist (d (symbols DB)) (extend temp-sql-query (rest (rest (rest (string d))))))
+		(extend temp-sql-query "=")
+		; why am I doing a loop here?  There should be only one value, right?  But maybe for future extension...
+		(dolist (q temp-record-values)
+			(if (string? q) (extend temp-sql-query "'")) ; only quote if value is non-numeric
+			(extend temp-sql-query (string (safe-for-sql q)))
+			(if (string? q) (extend temp-sql-query "'"))) ; close quote if value is non-numeric
+		(extend temp-sql-query ";")
+	)
+		; otherwise, just get everything in that table
+		(set 'temp-sql-query (string "SELECT * FROM " temp-table-name ";"))
+	)
+	;(displayln "TEMP-GET-QUERY: " temp-sql-query)	
+	(delete 'DB) ; we're done, so delete all symbols in the DB context.
+	(set 'return-value (query temp-sql-query)) ; this returns a list of everything in the record
+)
+
+; END FUNCTIONS ===================
+
+
+(open-database "SERVER-LOGS")
+(query "CREATE TABLE Logs (Id INTEGER PRIMARY KEY, IP TEXT, UserId TEXT, UserName TEXT, Date DATE, Request TEXT, Result TEXT, Size INTEGER, Referrer TEXT, UserAgent TEXT)")
+;(print (query "SELECT * from SQLITE_MASTER;"))
+(set 'access-log (read-file "/var/log/apache2/access.log"))
+(set 'access-list (parse access-log "\n"))
+(set 'max-items (integer (first (first (query "select count(*) from Logs")))))
+(println "Number of items in database: " max-items)
+(println "Number of lines in log: " (length access-list))
+(dolist (line access-list)
+	(set 'line-list (parse line))
+	;(println "Line# " $idx " - " line-list)
+	;(println "Length of line: " (length line-list))
+	(if (> (length line-list) 0) (begin
+		(++ max-items)
+		(set 'Id max-items) (print $idx "/" (length access-list))
+		(set 'IP (string (line-list 0) (line-list 1) (line-list 2))) 
+		(set 'UserId (line-list 3))
+		(set 'UserName (line-list 4))
+		(set 'Date (line-list 5))
+		(set 'Date (trim Date "["))
+		(set 'Date (trim Date "]")) 
+		;(println "DATE: " Date) 
+		(set 'date-parsed (date-parse Date "%d/%b/%Y:%H:%M:%S -0700"))
+		;(println "DATE-PARSED: " date-parsed)
+		(set 'Date (date date-parsed 0 "%Y-%m-%dT%H:%M:%S"))
+		(println " " Date)
+		(set 'Request (line-list 6))
+		(set 'Result (line-list 7))
+		(set 'Size (line-list 8))
+		(set 'Referrer (line-list 9))
+		(set 'UserAgent (line-list 10)) 
+		(create-record "Logs" Id IP UserId UserName Date Request Result Size Referrer UserAgent)
+	))
+)
+(close-database)
+(exit)

samples/Pascal/cwindirs.pp

@@ -0,0 +1,121 @@
+
+unit cwindirs;
+
+
+
+
+interface
+
+uses
+  windows,
+  strings;
+
+Const
+  CSIDL_PROGRAMS                = $0002;
+  CSIDL_PERSONAL                = $0005;
+  CSIDL_FAVORITES               = $0006;
+  CSIDL_STARTUP                 = $0007;
+  CSIDL_RECENT                  = $0008;
+  CSIDL_SENDTO                  = $0009;
+  CSIDL_STARTMENU               = $000B;
+  CSIDL_MYMUSIC                 = $000D;
+  CSIDL_MYVIDEO                 = $000E;
+  CSIDL_DESKTOPDIRECTORY        = $0010;
+  CSIDL_NETHOOD                 = $0013;
+  CSIDL_TEMPLATES               = $0015;
+  CSIDL_COMMON_STARTMENU        = $0016;
+  CSIDL_COMMON_PROGRAMS         = $0017;
+  CSIDL_COMMON_STARTUP          = $0018;
+  CSIDL_COMMON_DESKTOPDIRECTORY = $0019;
+  CSIDL_APPDATA                 = $001A;
+  CSIDL_PRINTHOOD               = $001B;
+  CSIDL_LOCAL_APPDATA           = $001C;
+  CSIDL_COMMON_FAVORITES        = $001F;
+  CSIDL_INTERNET_CACHE          = $0020;
+  CSIDL_COOKIES                 = $0021;
+  CSIDL_HISTORY                 = $0022;
+  CSIDL_COMMON_APPDATA          = $0023;
+  CSIDL_WINDOWS                 = $0024;
+  CSIDL_SYSTEM                  = $0025;
+  CSIDL_PROGRAM_FILES           = $0026;
+  CSIDL_MYPICTURES              = $0027;
+  CSIDL_PROFILE                 = $0028;
+  CSIDL_PROGRAM_FILES_COMMON    = $002B;
+  CSIDL_COMMON_TEMPLATES        = $002D;
+  CSIDL_COMMON_DOCUMENTS        = $002E;
+  CSIDL_COMMON_ADMINTOOLS       = $002F;
+  CSIDL_ADMINTOOLS              = $0030;
+  CSIDL_COMMON_MUSIC            = $0035;
+  CSIDL_COMMON_PICTURES         = $0036;
+  CSIDL_COMMON_VIDEO            = $0037;
+  CSIDL_CDBURN_AREA             = $003B;
+  CSIDL_PROFILES                = $003E;
+
+  CSIDL_FLAG_CREATE             = $8000;
+
+Function GetWindowsSpecialDir(ID :  Integer) : String;
+
+implementation
+
+uses
+  sysutils;
+
+Type
+  PFNSHGetFolderPath = Function(Ahwnd: HWND; Csidl: Integer; Token: THandle; Flags: DWord; Path: PChar): HRESULT; stdcall;
+
+
+var
+  SHGetFolderPath : PFNSHGetFolderPath = Nil;
+  CFGDLLHandle : THandle = 0;
+
+Procedure InitDLL;
+
+Var
+  pathBuf: array[0..MAX_PATH-1] of char;
+  pathLength: Integer;
+begin
+  { Load shfolder.dll using a full path, in order to prevent spoofing (Mantis #18185)
+    Don't bother loading shell32.dll because shfolder.dll itself redirects SHGetFolderPath
+    to shell32.dll whenever possible. }
+  pathLength:=GetSystemDirectory(pathBuf, MAX_PATH);
+  if (pathLength>0) and (pathLength<MAX_PATH-14) then
+  begin
+    StrLCopy(@pathBuf[pathLength],'\shfolder.dll',MAX_PATH-pathLength-1);
+    CFGDLLHandle:=LoadLibrary(pathBuf);
+
+    if (CFGDLLHandle<>0) then
+    begin
+      Pointer(ShGetFolderPath):=GetProcAddress(CFGDLLHandle,'SHGetFolderPathA');
+      If @ShGetFolderPath=nil then
+      begin
+        FreeLibrary(CFGDLLHandle);
+        CFGDllHandle:=0;
+      end;
+    end;
+  end;
+  If (@ShGetFolderPath=Nil) then
+    Raise Exception.Create('Could not determine SHGetFolderPath Function');
+end;
+
+Function GetWindowsSpecialDir(ID :  Integer) : String;
+
+Var
+  APath : Array[0..MAX_PATH] of char;
+
+begin
+  Result:='';
+  if (CFGDLLHandle=0) then
+    InitDLL;
+  If (SHGetFolderPath<>Nil) then
+    begin
+    if SHGetFolderPath(0,ID or CSIDL_FLAG_CREATE,0,0,@APATH[0])=S_OK then
+      Result:=IncludeTrailingPathDelimiter(StrPas(@APath[0]));
+    end;
+end;
+
+Initialization
+Finalization
+  if CFGDLLHandle<>0 then
+   FreeLibrary(CFGDllHandle);
+end.
+

samples/Pascal/gtkextra.pp

@@ -1,51 +0,0 @@
-{ $Id$ }
-{
- ---------------------------------------------------------------------------
- gtkextra.pp  -  GTK(2) widgetset - additional gdk/gtk functions
- ---------------------------------------------------------------------------
-
- This unit contains missing gdk/gtk functions and defines for certain 
- versions of gtk or fpc.
-
- ---------------------------------------------------------------------------
-
- @created(Sun Jan 28th WET 2006)
- @lastmod($Date$)
- @author(Marc Weustink <marc@@dommelstein.nl>)
-
- *****************************************************************************
-  This file is part of the Lazarus Component Library (LCL)
-
-  See the file COPYING.modifiedLGPL.txt, included in this distribution,
-  for details about the license.
- *****************************************************************************
- }
-
-unit GtkExtra;
-
-{$mode objfpc}{$H+}
-
-interface
-
-{$I gtkdefines.inc}
-
-{$ifdef gtk1}
-{$I gtk1extrah.inc}
-{$endif}
-
-{$ifdef gtk2}
-{$I gtk2extrah.inc}
-{$endif}
-
-
-implementation
-
-{$ifdef gtk1}
-{$I gtk1extra.inc}
-{$endif}
-
-{$ifdef gtk2}
-{$I gtk2extra.inc}
-{$endif}
-
-end.

samples/Pascal/large.pp

@@ -0,0 +1,22 @@
+program large;
+
+  const
+     max = 100000000;
+
+  type
+     tlist = array[1..max] of longint;
+
+  var
+     data : tlist;
+	i : integer;
+
+begin
+
+  i := 0;
+  while(i < max) 
+  do
+	begin
+		data[i] := 0;
+		Writeln(data[i])
+	end
+end.

samples/Pascal/tw27294.pp

@@ -0,0 +1,26 @@
+uses
+  uw27294;
+
+var
+  p : procedure;
+
+procedure test;
+
+begin
+  p:=@test;
+  writeln('OK');
+end;
+
+procedure global;
+begin
+  p:=nil;
+  test;
+  p();
+end;
+
+begin
+  global;
+  uw27294.global;
+end.
+
+

samples/PowerShell/ZLocation.psd1

@@ -0,0 +1,116 @@
+#
+# Module manifest for module 'ZLocation'
+#
+# Generated by: sevoroby
+#
+# Generated on: 12/10/2014
+#
+
+@{
+
+# Script module or binary module file associated with this manifest.
+RootModule = 'ZLocation.psm1'
+
+# Version number of this module.
+ModuleVersion = '0.1'
+
+# ID used to uniquely identify this module
+GUID = '18e8ca17-7f67-4f1c-85ff-159373bf66f5'
+
+# Author of this module
+Author = 'Sergei Vorobev'
+
+# Company or vendor of this module
+CompanyName = 'Microsoft'
+
+# Copyright statement for this module
+Copyright = '(c) 2014 Sergei Vorobev. All rights reserved.'
+
+# Description of the functionality provided by this module
+# Description = ''
+
+# Minimum version of the Windows PowerShell engine required by this module
+# PowerShellVersion = ''
+
+# Name of the Windows PowerShell host required by this module
+# PowerShellHostName = ''
+
+# Minimum version of the Windows PowerShell host required by this module
+# PowerShellHostVersion = ''
+
+# Minimum version of Microsoft .NET Framework required by this module
+# DotNetFrameworkVersion = ''
+
+# Minimum version of the common language runtime (CLR) required by this module
+# CLRVersion = ''
+
+# Processor architecture (None, X86, Amd64) required by this module
+# ProcessorArchitecture = ''
+
+# Modules that must be imported into the global environment prior to importing this module
+# RequiredModules = @()
+
+# Assemblies that must be loaded prior to importing this module
+# RequiredAssemblies = @()
+
+# Script files (.ps1) that are run in the caller's environment prior to importing this module.
+# ScriptsToProcess = @()
+
+# Type files (.ps1xml) to be loaded when importing this module
+# TypesToProcess = @()
+
+# Format files (.ps1xml) to be loaded when importing this module
+# FormatsToProcess = @()
+
+# Modules to import as nested modules of the module specified in RootModule/ModuleToProcess
+NestedModules = @("ZLocation.Storage.psm1", "ZLocation.Search.psm1")
+
+# Functions to export from this module
+FunctionsToExport = '*'
+
+# Cmdlets to export from this module
+CmdletsToExport = '*'
+
+# Variables to export from this module
+VariablesToExport = '*'
+
+# Aliases to export from this module
+AliasesToExport = '*'
+
+# List of all modules packaged with this module
+# ModuleList = @()
+
+# List of all files packaged with this module
+# FileList = @()
+
+# Private data to pass to the module specified in RootModule/ModuleToProcess. This may also contain a PSData hashtable with additional module metadata used by PowerShell.
+PrivateData = @{
+
+    PSData = @{
+
+        # Tags applied to this module. These help with module discovery in online galleries.
+        # Tags = @()
+
+        # A URL to the license for this module.
+        # LicenseUri = ''
+
+        # A URL to the main website for this project.
+        # ProjectUri = ''
+
+        # A URL to an icon representing this module.
+        # IconUri = ''
+
+        # ReleaseNotes of this module
+        # ReleaseNotes = ''
+
+    } # End of PSData hashtable
+
+} # End of PrivateData hashtable
+
+# HelpInfo URI of this module
+# HelpInfoURI = ''
+
+# Default prefix for commands exported from this module. Override the default prefix using Import-Module -Prefix.
+# DefaultCommandPrefix = ''
+
+}

samples/PowerShell/ZLocation.psm1

@@ -0,0 +1,91 @@
+#
+# Weight function.
+#
+function Update-ZLocation([string]$path)
+{
+    $now = [datetime]::Now
+    if (Test-Path variable:global:__zlocation_current)
+    {
+        $prev = $global:__zlocation_current
+        $weight = $now.Subtract($prev.Time).TotalSeconds
+        Add-ZWeight ($prev.Location) $weight 
+    }
+
+    $global:__zlocation_current = @{
+        Location = $path
+        Time = [datetime]::Now
+    }
+
+    # populate folder immidiatly after the first cd
+    Add-ZWeight $path 0
+}
+
+# this approach hurts `cd` performance (0.0008 sec vs 0.025 sec). 
+# Consider replace it with OnIdle Event.
+(Get-Variable pwd).attributes.Add((new-object ValidateScript { Update-ZLocation $_.Path; return $true }))
+#
+# End of weight function.
+#
+
+
+#
+# Tab complention.
+#
+if (Test-Path Function:\TabExpansion) {
+    Rename-Item Function:\TabExpansion PreZTabExpansion
+}
+
+function Get-EscapedPath
+{
+    param( 
+    [Parameter(
+        Position=0, 
+        Mandatory=$true, 
+        ValueFromPipeline=$true,
+        ValueFromPipelineByPropertyName=$true)
+    ]
+    [string]$path
+    ) 
+
+    process {
+        if ($path.Contains(' '))
+        {
+            return '"' + $path + '"'
+        }
+        return $path
+    }
+}
+
+function global:TabExpansion($line, $lastWord) {
+    switch -regex ($line) {
+        "^(Set-ZLocation|z) .*" {
+            $arguments = $line -split ' ' | Where { $_.length -gt 0 } | select -Skip 1
+            Find-Matches (Get-ZLocation) $arguments | Get-EscapedPath
+        }
+        default {
+            if (Test-Path Function:\PreZTabExpansion) {
+                PreZTabExpansion $line $lastWord
+            }
+        }
+    }
+}
+#
+# End of tab completion.
+#
+
+function Set-ZLocation()
+{
+    if (-not $args) {
+        $args = @()
+    }
+    $matches = Find-Matches (Get-ZLocation) $args
+    if ($matches) {
+        Push-Location ($matches | Select-Object -First 1)
+    } else {
+        Write-Warning "Cannot find matching location"
+    }
+}
+
+
+Set-Alias -Name z -Value Set-ZLocation
+Export-ModuleMember -Function Set-ZLocation, Get-ZLocation -Alias z

samples/PowerShell/hello.ps1

@@ -1,2 +0,0 @@
-# Hello world in powershell
-Write-Host 'Hello World'

samples/PowerShell/hello.psm1

@@ -1,5 +0,0 @@
-# Hello World powershell module
-
-function hello() {
-  Write-Host 'Hello World'
-}

samples/PowerShell/history.ps1

@@ -0,0 +1,65 @@
+function Save-HistoryAll() {
+    $history = Get-History -Count $MaximumHistoryCount
+    [array]::Reverse($history)
+    $history = $history | Group CommandLine | Foreach {$_.Group[0]}
+    [array]::Reverse($history)
+    $history | Export-Csv $historyPath
+}
+
+function Save-HistoryIncremental() {
+#    Get-History -Count $MaximumHistoryCount | Group CommandLine | Foreach {$_.Group[0]} | Export-Csv $historyPath 
+    Get-History -Count 1 | Export-Csv -Append $historyPath 
+}
+ 
+# hook powershell's exiting event & hide the registration with -supportevent.
+#Register-EngineEvent -SourceIdentifier powershell.exiting -SupportEvent -Action { Save-History }
+
+$oldPrompt = Get-Content function:\prompt
+
+if( $oldPrompt -notlike '*Save-HistoryIncremental*' )
+{
+    $newPrompt = @'
+Save-HistoryIncremental
+
+'@
+    $newPrompt += $oldPrompt
+    $function:prompt = [ScriptBlock]::Create($newPrompt)
+}
+ 
+# load previous history, if it exists
+if ((Test-Path $historyPath)) {
+    $loadTime = 
+    (
+        Measure-Command {
+            Import-Csv $historyPath | Add-History
+            Save-HistoryAll
+            Clear-History
+            Import-Csv $historyPath | ? {$count++;$true} | Add-History
+        }
+    ).totalseconds
+    Write-Host -Fore Green "`nLoaded $count history item(s) in $loadTime seconds.`n"
+}
+
+
+function Search-History()
+{
+    <#
+    .SYNOPSIS
+        Retrive and filter history based on query
+    .DESCRIPTION
+    .PARAMETER Name
+    .EXAMPLE
+    .LINK
+    #>
+
+    param(
+        [string[]] $query
+    )
+
+    $history = Get-History -Count $MaximumHistoryCount
+    foreach ($item in $query){
+        $item = $item.ToLower()
+        $history = $history | where {$_.CommandLine.ToLower().Contains($item)}    
+    }
+    $history
+}

test/test_heuristics.rb

@@ -133,6 +133,13 @@ class TestHeuristcs < Minitest::Test
     })
   end
 
+  def test_lsp_by_heuristics
+    assert_heuristics({
+      "Common Lisp" => all_fixtures("Common Lisp"),
+      "NewLisp" => all_fixtures("NewLisp")
+    })
+  end
+
   def test_cs_by_heuristics
     assert_heuristics({
       "C#" => all_fixtures("C#", "*.cs"),

test/test_tokenizer.rb

@@ -41,6 +41,8 @@ class TestTokenizer < Minitest::Test
     assert_equal %w(foo), tokenize("foo {- Comment -}")
     assert_equal %w(foo), tokenize("foo (* Comment *)")
     assert_equal %w(%), tokenize("2 % 10\n% Comment")
+    assert_equal %w(foo bar), tokenize("foo\n\"\"\"\nComment\n\"\"\"\nbar")
+    assert_equal %w(foo bar), tokenize("foo\n'''\nComment\n'''\nbar")
   end
 
   def test_sgml_tags