KevinMidboe/linguist
1
0
Fork 0
mirror of https://github.com/KevinMidboe/linguist.git synced 2025-10-29 17:50:22 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'master' into feature-Mathematica10Extensions

Browse Source
This commit is contained in:
halirutan
2015-01-26 01:43:13 +01:00
parent e468723abc 8aa4dce6f4
commit 8e52c18200
12 changed files with 656 additions and 52 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
lib/linguist/heuristics.rb
View File

@@ -181,6 +181,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"]

13
lib/linguist/languages.yml
View File

@@ -1888,6 +1888,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:

3
lib/linguist/tokenizer.rb
View File

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

21
samples/Common Lisp/sample.lsp Normal file
View File

@@ -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))

239
samples/NewLisp/irc.lsp Normal file
View File

@@ -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]

195
samples/NewLisp/log-to-database.lisp Normal file
View File

@@ -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 "&amp;")
(replace "'" str-sql-query "&apos;")
(replace "\"" str-sql-query "&quot;")
))
(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)

121
samples/Pascal/cwindirs.pp Normal file
View File

@@ -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.

51
samples/Pascal/gtkextra.pp
View File

@@ -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.

22
samples/Pascal/large.pp Normal file
View File

@@ -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.

26
samples/Pascal/tw27294.pp Normal file
View File

@@ -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.

7
test/test_heuristics.rb
View File

@@ -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"),

2
test/test_tokenizer.rb
View File

@@ -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