diff --git a/.gitmodules b/.gitmodules index 79209740..19fb9472 100644 --- a/.gitmodules +++ b/.gitmodules @@ -121,9 +121,9 @@ [submodule "vendor/grammars/Handlebars"] path = vendor/grammars/Handlebars url = https://github.com/daaain/Handlebars -[submodule "vendor/grammars/powershell.tmbundle"] - path = vendor/grammars/powershell.tmbundle - url = https://github.com/davidpeckham/powershell.tmbundle +[submodule "vendor/grammars/powershell"] + path = vendor/grammars/powershell + 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 diff --git a/LICENSE b/LICENSE index f09a7d0a..c0a52444 100644 --- a/LICENSE +++ b/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 diff --git a/grammars.yml b/grammars.yml index c85b2de6..e446a8fa 100644 --- a/grammars.yml +++ b/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 diff --git a/lib/linguist/heuristics.rb b/lib/linguist/heuristics.rb index c9c685a4..72484ba6 100644 --- a/lib/linguist/heuristics.rb +++ b/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?(" # # - # 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'], diff --git a/lib/linguist/languages.yml b/lib/linguist/languages.yml index af0472c8..8b5c1525 100644 --- a/lib/linguist/languages.yml +++ b/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" diff --git a/lib/linguist/tokenizer.rb b/lib/linguist/tokenizer.rb index 4b2ea607..05882649 100644 --- a/lib/linguist/tokenizer.rb +++ b/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| diff --git a/samples/Common Lisp/sample.lsp b/samples/Common Lisp/sample.lsp new file mode 100644 index 00000000..9bef6781 --- /dev/null +++ b/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)) diff --git a/samples/GAP/bugfix.tst b/samples/GAP/bugfix.tst new file mode 100644 index 00000000..be4bd975 --- /dev/null +++ b/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"); + +gap> x := F.1;; y := F.2;; +gap> G := F/[x^2/y^24, y^24, y^x/y^23]; + +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); diff --git a/samples/GAP/factor.tst b/samples/GAP/factor.tst new file mode 100644 index 00000000..115fe921 --- /dev/null +++ b/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); diff --git a/samples/NewLisp/irc.lsp b/samples/NewLisp/irc.lsp new file mode 100644 index 00000000..0cac4034 --- /dev/null +++ b/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] \ No newline at end of file diff --git a/samples/NewLisp/log-to-database.lisp b/samples/NewLisp/log-to-database.lisp new file mode 100644 index 00000000..60af8406 --- /dev/null +++ b/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 "
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 "

TABLE NAME: " temp-table-name) + ;(displayln "

SYMBOLS: " (symbols DB)) + ;(displayln "
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 "

***** 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 "
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 "

TABLE NAME: " temp-table-name) + ;(displayln "

SYMBOLS: " (symbols D2)) + ;(displayln "
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 "

***** 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) \ No newline at end of file diff --git a/samples/Pascal/cwindirs.pp b/samples/Pascal/cwindirs.pp new file mode 100644 index 00000000..d97895e3 --- /dev/null +++ b/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 (pathLength0) 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. + diff --git a/samples/Pascal/gtkextra.pp b/samples/Pascal/gtkextra.pp deleted file mode 100644 index 9f2ebf8c..00000000 --- a/samples/Pascal/gtkextra.pp +++ /dev/null @@ -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 ) - - ***************************************************************************** - 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. diff --git a/samples/Pascal/large.pp b/samples/Pascal/large.pp new file mode 100644 index 00000000..9e0f4867 --- /dev/null +++ b/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. diff --git a/samples/Pascal/tw27294.pp b/samples/Pascal/tw27294.pp new file mode 100644 index 00000000..34d14f5d --- /dev/null +++ b/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. + + diff --git a/samples/PowerShell/ZLocation.psd1 b/samples/PowerShell/ZLocation.psd1 new file mode 100644 index 00000000..fcf90ef9 --- /dev/null +++ b/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 = '' + +} diff --git a/samples/PowerShell/ZLocation.psm1 b/samples/PowerShell/ZLocation.psm1 new file mode 100644 index 00000000..5ab91146 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/samples/PowerShell/hello.ps1 b/samples/PowerShell/hello.ps1 deleted file mode 100644 index eca1e76c..00000000 --- a/samples/PowerShell/hello.ps1 +++ /dev/null @@ -1,2 +0,0 @@ -# Hello world in powershell -Write-Host 'Hello World' \ No newline at end of file diff --git a/samples/PowerShell/hello.psm1 b/samples/PowerShell/hello.psm1 deleted file mode 100644 index 3db82f01..00000000 --- a/samples/PowerShell/hello.psm1 +++ /dev/null @@ -1,5 +0,0 @@ -# Hello World powershell module - -function hello() { - Write-Host 'Hello World' -} \ No newline at end of file diff --git a/samples/PowerShell/history.ps1 b/samples/PowerShell/history.ps1 new file mode 100644 index 00000000..3161a3cb --- /dev/null +++ b/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 +} \ No newline at end of file diff --git a/test/test_heuristics.rb b/test/test_heuristics.rb index 785fe58e..b88d0fda 100644 --- a/test/test_heuristics.rb +++ b/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"), diff --git a/test/test_tokenizer.rb b/test/test_tokenizer.rb index 24a74105..339d5485 100644 --- a/test/test_tokenizer.rb +++ b/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 diff --git a/vendor/grammars/liquid.tmbundle b/vendor/grammars/liquid.tmbundle new file mode 160000 index 00000000..c65939f1 --- /dev/null +++ b/vendor/grammars/liquid.tmbundle @@ -0,0 +1 @@ +Subproject commit c65939f11ad9a91b8c4660a357c36660e9a09e6c diff --git a/vendor/grammars/powershell b/vendor/grammars/powershell new file mode 160000 index 00000000..84fd9726 --- /dev/null +++ b/vendor/grammars/powershell @@ -0,0 +1 @@ +Subproject commit 84fd97265c93abcd52de5915b4cf1179cc508373 diff --git a/vendor/grammars/powershell.tmbundle b/vendor/grammars/powershell.tmbundle deleted file mode 160000 index f8716b43..00000000 --- a/vendor/grammars/powershell.tmbundle +++ /dev/null @@ -1 +0,0 @@ -Subproject commit f8716b432eb0a1a6cbc93ee42451a443db844c0f diff --git a/vendor/grammars/swift.tmbundle b/vendor/grammars/swift.tmbundle index 0cd27c70..4b3af145 160000 --- a/vendor/grammars/swift.tmbundle +++ b/vendor/grammars/swift.tmbundle @@ -1 +1 @@ -Subproject commit 0cd27c708953230e10571ccb88a4b24eedf762bb +Subproject commit 4b3af145fedd1df488e28e6ae6249530d6a4389c