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 pull request #143 from abevoelker/improve-cls-detection

Browse Source 
Improve .cls language detection
This commit is contained in:
Joshua Peek
2012-03-21 11:47:22 -07:00
parent 777f5a3b87 22db59d8c0
commit 33366bab0c
10 changed files with 1542 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
lib/linguist/blob_helper.rb
View File

@@ -423,8 +423,15 @@ module Linguist
def guess_cls_language
if lines.grep(/^(%|\\)/).any?
Language['TeX']
else
elsif lines.grep(/^\s*(CLASS|METHOD|INTERFACE).*:\s*/i).any? || lines.grep(/^\s*(USING|DEFINE)/i).any?
Language['OpenEdge ABL']
elsif lines.grep(/\{$/).any? || lines.grep(/\}$/).any?
Language['Apex']
elsif lines.grep(/^(\'\*|Attribute|Option|Sub|Private|Protected|Public|Friend)/i).any?
Language['Visual Basic']
else
# The most common language should be the fallback
Language['TeX']
end
end

10
lib/linguist/languages.yml
View File

@@ -54,6 +54,12 @@ Ada:
- .adb
- .ads
Apex:
type: programming
lexer: Text only
extensions:
- .cls
AppleScript:
aliases:
- osascript
@@ -747,8 +753,6 @@ OpenEdge ABL:
- openedge
- abl
primary_extension: .p
overrides:
- .cls
extensions:
- .cls
- .p
@@ -1053,6 +1057,8 @@ Tcsh:
TeX:
type: markup
primary_extension: .tex
overrides:
- .cls
extensions:
- .aux
- .cls

458
test/fixtures/ArrayUtils.cls vendored Normal file
View File

@@ -0,0 +1,458 @@
/* ============================================================
* This code is part of the "apex-lang" open source project avaiable at:
*
* http://code.google.com/p/apex-lang/
*
* This code is licensed under the Apache License, Version 2.0. You may obtain a
* copy of the License at:
*
* http://www.apache.org/licenses/LICENSE-2.0
* ============================================================
*/
global class ArrayUtils {
global static String[] EMPTY_STRING_ARRAY = new String[]{};
global static Integer MAX_NUMBER_OF_ELEMENTS_IN_LIST {get{return 1000;}}
global static List<String> objectToString(List<Object> objects){
List<String> strings = null;
if(objects != null){
strings = new List<String>();
if(objects.size() > 0){
for(Object obj : objects){
if(obj instanceof String){
strings.add((String)obj);
}
}
}
}
return strings;
}
global static Object[] reverse(Object[] anArray) {
if (anArray == null) {
return null;
}
Integer i = 0;
Integer j = anArray.size() - 1;
Object tmp;
while (j > i) {
tmp = anArray[j];
anArray[j] = anArray[i];
anArray[i] = tmp;
j--;
i++;
}
return anArray;
}
global static SObject[] reverse(SObject[] anArray) {
if (anArray == null) {
return null;
}
Integer i = 0;
Integer j = anArray.size() - 1;
SObject tmp;
while (j > i) {
tmp = anArray[j];
anArray[j] = anArray[i];
anArray[i] = tmp;
j--;
i++;
}
return anArray;
}
global static List<String> lowerCase(List<String> strs){
List<String> returnValue = null;
if(strs != null){
returnValue = new List<String>();
if(strs.size() > 0){
for(String str : strs){
returnValue.add(str == null ? null : str.toLowerCase());
}
}
}
return returnValue;
}
global static List<String> upperCase(List<String> strs){
List<String> returnValue = null;
if(strs != null){
returnValue = new List<String>();
if(strs.size() > 0){
for(String str : strs){
returnValue.add(str == null ? null : str.toUpperCase());
}
}
}
return returnValue;
}
global static List<String> trim(List<String> strs){
List<String> returnValue = null;
if(strs != null){
returnValue = new List<String>();
if(strs.size() > 0){
for(String str : strs){
returnValue.add(str == null ? null : str.trim());
}
}
}
return returnValue;
}
global static Object[] mergex(Object[] array1, Object[] array2){
if(array1 == null){ return array2; }
if(array2 == null){ return array1; }
Object[] merged = new Object[array1.size() + array2.size()];
for(Integer i = 0; i < array1.size(); i++){
merged[i] = array1[i];
}
for(Integer i = 0; i < array2.size(); i++){
merged[i+array1.size()] = array2[i];
}
return merged;
}
global static SObject[] mergex(SObject[] array1, SObject[] array2){
if(array1 == null){ return array2; }
if(array2 == null){ return array1; }
if(array1.size() <= 0){ return array2; }
List<SObject> merged = new List<SObject>();
for(SObject sObj : array1){ merged.add(sObj); }
for(SObject sObj : array2){ merged.add(sObj); }
return merged;
}
global static Boolean isEmpty(Object[] objectArray){
if(objectArray == null){
return true;
}
return objectArray.size() == 0;
}
global static Boolean isEmpty(SObject[] objectArray){
if(objectArray == null){
return true;
}
return objectArray.size() == 0;
}
global static Boolean isNotEmpty(Object[] objectArray){
return !isEmpty(objectArray);
}
global static Boolean isNotEmpty(SObject[] objectArray){
return !isEmpty(objectArray);
}
global static Object[] pluck(SObject[] objectArray, String fieldName){
if(isEmpty(objectArray) || fieldName == null || fieldName.trim() == null || fieldName.trim().length() == 0){
return new Object[]{};
}
Object[] plucked = new Object[objectArray.size()];
for(Integer i = 0; i < objectArray.size(); i++){
plucked[i] = objectArray[i].get(fieldName);
}
return plucked;
}
global static String toString(Object[] objectArray){
if(objectArray == null){
return 'null';
}
String returnValue = '{';
for(Integer i = 0; i < objectArray.size(); i++){
if(i!=0){ returnValue += ','; }
returnValue += '\'' + objectArray[i] + '\'';
}
returnValue += '}';
return returnValue;
}
global static String toString(SObject[] objectArray){
if(objectArray == null){
return 'null';
}
String returnValue = '{';
for(Integer i = 0; i < objectArray.size(); i++){
if(i!=0){ returnValue += ','; }
returnValue += '\'' + objectArray[i] + '\'';
}
returnValue += '}';
return returnValue;
}
global static void assertArraysAreEqual(Object[] expected, Object[] actual){
//check to see if one param is null but the other is not
System.assert((expected == null && actual == null)|| (expected != null && actual != null),
'Assertion failed, the following two arrays are not equal. Expected: '
+ ArrayUtils.toString(expected) + ', Actual: ' + ArrayUtils.toString(actual));
if(expected != null && actual != null){
System.assert(expected.size() == actual.size(), 'Assertion failed, the following two arrays are not equal. Expected: '
+ ArrayUtils.toString(expected) + ', Actual: ' + ArrayUtils.toString(actual));
for(Integer i = 0; i < expected.size(); i++){
System.assert(expected[i] == actual[i], 'Assertion failed, the following two arrays are not equal. Expected: '
+ ArrayUtils.toString(expected) + ', Actual: ' + ArrayUtils.toString(actual));
}
}
}
global static void assertArraysAreEqual(SObject[] expected, SObject[] actual){
//check to see if one param is null but the other is not
System.assert((expected == null && actual == null)|| (expected != null && actual != null),
'Assertion failed, the following two arrays are not equal. Expected: '
+ ArrayUtils.toString(expected) + ', Actual: ' + ArrayUtils.toString(actual));
if(expected != null && actual != null){
System.assert(expected.size() == actual.size(), 'Assertion failed, the following two arrays are not equal. Expected: '
+ ArrayUtils.toString(expected) + ', Actual: ' + ArrayUtils.toString(actual));
for(Integer i = 0; i < expected.size(); i++){
System.assert(expected[i] == actual[i], 'Assertion failed, the following two arrays are not equal. Expected: '
+ ArrayUtils.toString(expected) + ', Actual: ' + ArrayUtils.toString(actual));
}
}
}
global static List<Object> merg(List<Object> list1, List<Object> list2) {
List<Object> returnList = new List<Object>();
if(list1 != null && list2 != null && (list1.size()+list2.size()) > MAX_NUMBER_OF_ELEMENTS_IN_LIST){
throw new IllegalArgumentException('Lists cannot be merged because new list would be greater than maximum number of elements in a list: ' + MAX_NUMBER_OF_ELEMENTS_IN_LIST);
}
if(isNotEmpty(list1)){
for(Object elmt : list1){
returnList.add(elmt);
}
}
if(isNotEmpty(list2)){
for(Object elmt : list2){
returnList.add(elmt);
}
}
return returnList;
}
global static List<SObject> merg(List<SObject> list1, List<SObject> list2) {
if(list1 != null && list2 != null && (list1.size()+list2.size()) > MAX_NUMBER_OF_ELEMENTS_IN_LIST){
throw new IllegalArgumentException('Lists cannot be merged because new list would be greater than maximum number of elements in a list: ' + MAX_NUMBER_OF_ELEMENTS_IN_LIST);
}
if(isEmpty(list1) && isEmpty(list2)){
return null;
}
List<SObject> returnList = new List<SObject>();
if(list1 != null){
for(SObject elmt : list1){
returnList.add(elmt);
}
}
if(list2 != null){
for(SObject elmt : list2){
returnList.add(elmt);
}
}
return returnList;
}
global static List<Object> subset(List<Object> aList, Integer count) {
return subset(aList,0,count);
}
global static List<Object> subset(List<Object> list1, Integer startIndex, Integer count) {
List<Object> returnList = new List<Object>();
if(list1 != null && list1.size() > 0 && startIndex >= 0 && startIndex <= list1.size()-1 && count > 0){
for(Integer i = startIndex; i < list1.size() && i - startIndex < count; i++){
returnList.add(list1.get(i));
}
}
return returnList;
}
global static List<SObject> subset(List<SObject> aList, Integer count) {
return subset(aList,0,count);
}
global static List<SObject> subset(List<SObject> list1, Integer startIndex, Integer count) {
List<SObject> returnList = null;
if(list1 != null && list1.size() > 0 && startIndex <= list1.size()-1 && count > 0){
returnList = new List<SObject>();
for(Integer i = startIndex; i < list1.size() && i - startIndex < count; i++){
returnList.add(list1.get(i));
}
}
return returnList;
}
//===============================================
//LIST/ARRAY SORTING
//===============================================
//FOR FORCE.COM PRIMITIVES (Double,Integer,ID,etc.):
global static List<Object> qsort(List<Object> theList) {
return qsort(theList,new PrimitiveComparator());
}
global static List<Object> qsort(List<Object> theList, Boolean sortAsc) {
return qsort(theList,new PrimitiveComparator(),sortAsc);
}
global static List<Object> qsort(List<Object> theList, ObjectComparator comparator) {
return qsort(theList,comparator,true);
}
global static List<Object> qsort(List<Object> theList, ObjectComparator comparator, Boolean sortAsc) {
return qsort(theList, 0, (theList == null ? 0 : theList.size()-1),comparator,sortAsc);
}
//FOR SALESFORCE OBJECTS (sObjects):
global static List<SObject> qsort(List<SObject> theList, ISObjectComparator comparator) {
return qsort(theList,comparator,true);
}
global static List<SObject> qsort(List<SObject> theList, ISObjectComparator comparator,Boolean sortAsc ) {
return qsort(theList, 0, (theList == null ? 0 : theList.size()-1),comparator,sortAsc);
}
private static List<Object> qsort(List<Object> theList,
Integer lo0,
Integer hi0,
ObjectComparator comparator,
Boolean sortAsc){
Integer lo = lo0;
Integer hi = hi0;
if (lo >= hi) {
return theList;
} else if( lo == hi - 1 ) {
if (( comparator.compare(theList[lo],theList[hi])>0 && sortAsc) ||
(comparator.compare(theList[lo],theList[hi])<0 && !sortAsc)
) {
Object prs = theList[lo];
theList[lo] = theList[hi];
theList[hi] = prs;
}
return theList;
}
Object pivot = theList[(lo + hi) / 2];
theList[(lo + hi) / 2] = theList[hi];
theList[hi] = pivot;
while( lo < hi ) {
while ((comparator.compare(theList[lo], pivot)<=0 && lo < hi && sortAsc) ||
(comparator.compare(theList[lo], pivot)>=0 && lo < hi && !sortAsc)
) { lo++; }
while (( comparator.compare(pivot,theList[hi])<=0 && lo < hi && sortAsc) ||
( comparator.compare(pivot,theList[hi])>=0 && lo < hi && !sortAsc)
) { hi--; }
if( lo < hi ){
Object prs = theList[lo];
theList[lo] = theList[hi];
theList[hi] = prs;
}
}
theList[hi0] = theList[hi];
theList[hi] = pivot;
qsort(theList, lo0, lo-1,comparator,sortAsc);
qsort(theList, hi+1, hi0,comparator,sortAsc);
return theList;
}
private static List<SObject> qsort(List<SObject> theList,
Integer lo0,
Integer hi0,
ISObjectComparator comparator,
Boolean sortAsc){
Integer lo = lo0;
Integer hi = hi0;
if (lo >= hi) {
return theList;
} else if( lo == hi - 1 ) {
if (( comparator.compare(theList[lo],theList[hi])>0 && sortAsc) ||
(comparator.compare(theList[lo],theList[hi])<0 && !sortAsc)
) {
SObject prs = theList[lo];
theList[lo] = theList[hi];
theList[hi] = prs;
}
return theList;
}
SObject pivot = theList[(lo + hi) / 2];
theList[(lo + hi) / 2] = theList[hi];
theList[hi] = pivot;
while( lo < hi ) {
while ((comparator.compare(theList[lo], pivot)<=0 && lo < hi && sortAsc) ||
(comparator.compare(theList[lo], pivot)>=0 && lo < hi && !sortAsc)
) { lo++; }
while (( comparator.compare(pivot,theList[hi])<=0 && lo < hi && sortAsc) ||
( comparator.compare(pivot,theList[hi])>=0 && lo < hi && !sortAsc)
) { hi--; }
if( lo < hi ){
SObject prs = theList[lo];
theList[lo] = theList[hi];
theList[hi] = prs;
}
}
theList[hi0] = theList[hi];
theList[hi] = pivot;
qsort(theList, lo0, lo-1,comparator,sortAsc);
qsort(theList, hi+1, hi0,comparator,sortAsc);
return theList;
}
/*
global static List<Object> unique(List<Object> theList) {
List<Object> uniques = new List<Object>();
Set<Object> keys = new Set<Object>();
if(theList != null && theList.size() > 0){
for(Object obj : theList){
if(keys.contains(obj)){
continue;
} else {
keys.add(obj);
uniques.add(obj);
}
}
}
return uniques;
}
global static List<SObject> unique(List<SObject> theList) {
if(theList == null){
return null;
}
List<SObject> uniques = createEmptySObjectList(theList.get(0));
Set<String> keys = new Set<String>();
if(theList != null && theList.size() > 0){
String key = null;
for(SObject obj : theList){
key = obj == null ? null : ''+obj;
if(keys.contains(key)){
continue;
} else {
keys.add(key);
uniques.add(obj);
}
}
}
return uniques;
}
*/
}

574
test/fixtures/Email.cls vendored Normal file
View File

@@ -0,0 +1,574 @@
/*------------------------------------------------------------------------
File : Email
Purpose : Abstraction of an Email message
Description : Holds information needed for an email message - senders,
recipients, subject, a message body, attachment files, and
other extra information such as importance, priority,
sensitivity, custom reply-to addresses, delivery receipts,
read receipts, custom sent date, reply-by date, and expire date.
Author(s) : Abe Voelker
Created : Sat Jul 17 16:27:05 CDT 2010
----------------------------------------------------------------------*/
USING Progress.Lang.*.
CLASS email.Email USE-WIDGET-POOL:
&SCOPED-DEFINE QUOTES """"
&SCOPED-DEFINE CR CHR(13)
&SCOPED-DEFINE LF CHR(10)
&SCOPED-DEFINE DEFAULT_MIME_BOUNDARY "!@#$%^&*+-._MIME_BOUNDARY_.-+*&^%$#@!"
/*------------------------------------------------------------------------------
Purpose:
Notes:
------------------------------------------------------------------------------*/
DEFINE PRIVATE VARIABLE objSendEmailAlgorithm AS email.SendEmailAlgorithm NO-UNDO.
DEFINE PRIVATE TEMP-TABLE ttSenders NO-UNDO
FIELD cEmailAddress AS CHARACTER
FIELD cRealName AS CHARACTER INITIAL ?
INDEX IXPK_ttSenders cEmailAddress.
DEFINE PRIVATE TEMP-TABLE ttToRecipients NO-UNDO
FIELD cEmailAddress AS CHARACTER
FIELD cRealName AS CHARACTER INITIAL ?
INDEX IXPK_ttToRecipients cEmailAddress.
DEFINE PRIVATE TEMP-TABLE ttCCRecipients NO-UNDO
FIELD cEmailAddress AS CHARACTER
FIELD cRealName AS CHARACTER INITIAL ?
INDEX IXPK_ttCCRecipients cEmailAddress.
DEFINE PRIVATE TEMP-TABLE ttBCCRecipients NO-UNDO
FIELD cEmailAddress AS CHARACTER
FIELD cRealName AS CHARACTER INITIAL ?
INDEX IXPK_ttBCCRecipients cEmailAddress.
DEFINE PRIVATE TEMP-TABLE ttReplyToRecipients NO-UNDO
FIELD cEmailAddress AS CHARACTER
FIELD cRealName AS CHARACTER INITIAL ?
INDEX IXPK_ttReplyToRecipients cEmailAddress.
DEFINE PRIVATE TEMP-TABLE ttReadReceiptRecipients NO-UNDO
FIELD cEmailAddress AS CHARACTER
FIELD cRealName AS CHARACTER INITIAL ?
INDEX IXPK_ttReadReceiptRecipients cEmailAddress.
DEFINE PRIVATE TEMP-TABLE ttDeliveryReceiptRecipients NO-UNDO
FIELD cEmailAddress AS CHARACTER
FIELD cRealName AS CHARACTER INITIAL ?
INDEX IXPK_ttDeliveryReceiptRecipients cEmailAddress.
DEFINE PRIVATE TEMP-TABLE ttAttachments NO-UNDO
FIELD cFileName AS CHARACTER
FIELD lcData AS Object /* Longchar object */
FIELD lBase64Encode AS LOGICAL.
DEFINE PRIVATE VARIABLE cMimeBoundary AS CHARACTER NO-UNDO.
DEFINE PRIVATE VARIABLE lcBody AS LONGCHAR NO-UNDO.
DEFINE PRIVATE VARIABLE lBodyIsBase64 AS LOGICAL NO-UNDO.
DEFINE PRIVATE VARIABLE cSubject AS CHARACTER NO-UNDO.
DEFINE PRIVATE VARIABLE mptrAttachments AS MEMPTR NO-UNDO.
DEFINE PRIVATE VARIABLE cImportance AS CHARACTER NO-UNDO.
DEFINE PRIVATE VARIABLE cSensitivity AS CHARACTER NO-UNDO.
DEFINE PRIVATE VARIABLE cPriority AS CHARACTER NO-UNDO.
DEFINE PRIVATE VARIABLE dttmtzSentDate AS DATETIME-TZ INITIAL ? NO-UNDO.
DEFINE PRIVATE VARIABLE dttmtzReplyByDate AS DATETIME-TZ INITIAL ? NO-UNDO.
DEFINE PRIVATE VARIABLE dttmtzExpireDate AS DATETIME-TZ INITIAL ? NO-UNDO.
DEFINE PRIVATE VARIABLE cNewLine AS CHARACTER NO-UNDO.
/* Other email headers: */
CONSTRUCTOR PUBLIC Email (INPUT ipobjSendEmailAlgorithm AS email.SendEmailAlgorithm):
SUPER ().
ASSIGN objSendEmailAlgorithm = ipobjSendEmailAlgorithm
cMimeBoundary = {&DEFAULT_MIME_BOUNDARY}
lBodyIsBase64 = TRUE.
IF (OPSYS BEGINS "WIN") THEN
ASSIGN cNewLine = {&CR} + {&LF}.
ELSE
ASSIGN cNewLine = {&LF}.
END CONSTRUCTOR.
DESTRUCTOR PUBLIC Email ():
FOR EACH ttAttachments:
IF VALID-OBJECT(ttAttachments.lcData) THEN
DELETE OBJECT ttAttachments.lcData NO-ERROR.
END. /* FOR EACH ttAttachments */
END DESTRUCTOR.
/* Add a sender ("From:" address) to the email */
METHOD PUBLIC VOID addSender(INPUT ipcEmailAddress AS CHARACTER):
IF NOT CAN-FIND(FIRST ttSenders
WHERE ttSenders.cEmailAddress EQ ipcEmailAddress) THEN DO:
CREATE ttSenders.
ASSIGN ttSenders.cEmailAddress = ipcEmailAddress.
END.
END METHOD.
/* Add a sender ("From:" address) (with Real Name) to the email */
METHOD PUBLIC VOID addSender(INPUT ipcEmailAddress AS CHARACTER,
INPUT ipcRealName AS CHARACTER):
IF NOT CAN-FIND(FIRST ttSenders
WHERE ttSenders.cEmailAddress EQ ipcEmailAddress) THEN DO:
CREATE ttSenders.
ASSIGN ttSenders.cEmailAddress = ipcEmailAddress
ttSenders.cRealName = ipcRealName.
END.
END METHOD.
/* Add a "To:" recipient to the email */
METHOD PUBLIC VOID addToRecipient(INPUT ipcEmailAddress AS CHARACTER):
IF NOT CAN-FIND(FIRST ttToRecipients
WHERE ttToRecipients.cEmailAddress EQ ipcEmailAddress) THEN DO:
CREATE ttToRecipients.
ASSIGN ttToRecipients.cEmailAddress = ipcEmailAddress.
END.
END METHOD.
/* Add a "To:" recipient (with Real Name) to the email */
METHOD PUBLIC VOID addToRecipient(INPUT ipcEmailAddress AS CHARACTER,
INPUT ipcRealName AS CHARACTER):
IF NOT CAN-FIND(FIRST ttToRecipients
WHERE ttToRecipients.cEmailAddress EQ ipcEmailAddress) THEN DO:
CREATE ttToRecipients.
ASSIGN ttToRecipients.cEmailAddress = ipcEmailAddress
ttToRecipients.cRealName = ipcRealName.
END.
END METHOD.
/* Add a "CC:" recipient to the email */
METHOD PUBLIC VOID addCCRecipient(INPUT ipcEmailAddress AS CHARACTER):
IF NOT CAN-FIND(FIRST ttCCRecipients
WHERE ttCCRecipients.cEmailAddress EQ ipcEmailAddress) THEN DO:
CREATE ttCCRecipients.
ASSIGN ttCCRecipients.cEmailAddress = ipcEmailAddress.
END.
END METHOD.
/* Add a "CC:" recipient (with Real Name) to the email */
METHOD PUBLIC VOID addCCRecipient(INPUT ipcEmailAddress AS CHARACTER,
INPUT ipcRealName AS CHARACTER):
IF NOT CAN-FIND(FIRST ttCCRecipients
WHERE ttCCRecipients.cEmailAddress EQ ipcEmailAddress) THEN DO:
CREATE ttCCRecipients.
ASSIGN ttCCRecipients.cEmailAddress = ipcEmailAddress
ttToRecipients.cRealName = ipcRealName.
END.
END METHOD.
/* Add a "BCC:" recipient to the email */
METHOD PUBLIC VOID addBCCRecipient(INPUT ipcEmailAddress AS CHARACTER):
IF NOT CAN-FIND(FIRST ttBCCRecipients
WHERE ttBCCRecipients.cEmailAddress EQ ipcEmailAddress) THEN DO:
CREATE ttBCCRecipients.
ASSIGN ttBCCRecipients.cEmailAddress = ipcEmailAddress.
END.
END METHOD.
/* Add a "BCC:" recipient (with Real Name) to the email */
METHOD PUBLIC VOID addBCCRecipient(INPUT ipcEmailAddress AS CHARACTER,
INPUT ipcRealName AS CHARACTER):
IF NOT CAN-FIND(FIRST ttBCCRecipients
WHERE ttBCCRecipients.cEmailAddress EQ ipcEmailAddress) THEN DO:
CREATE ttBCCRecipients.
ASSIGN ttBCCRecipients.cEmailAddress = ipcEmailAddress
ttToRecipients.cRealName = ipcRealName.
END.
END METHOD.
/* Add a reply-to recipient to the email */
METHOD PUBLIC VOID addReplyToRecipient(INPUT ipcEmailAddress AS CHARACTER):
IF NOT CAN-FIND(FIRST ttReplyToRecipients
WHERE ttReplyToRecipients.cEmailAddress EQ ipcEmailAddress) THEN DO:
CREATE ttReplyToRecipients.
ASSIGN ttReplyToRecipients.cEmailAddress = ipcEmailAddress.
END.
END METHOD.
/* Add a reply-to recipient (with Real Name) to the email */
METHOD PUBLIC VOID addReplyToRecipient(INPUT ipcEmailAddress AS CHARACTER,
INPUT ipcRealName AS CHARACTER):
IF NOT CAN-FIND(FIRST ttReplyToRecipients
WHERE ttReplyToRecipients.cEmailAddress EQ ipcEmailAddress) THEN DO:
CREATE ttReplyToRecipients.
ASSIGN ttReplyToRecipients.cEmailAddress = ipcEmailAddress
ttReplyToRecipients.cRealName = ipcRealName.
END.
END METHOD.
/* Add a delivery receipt recipient to the email */
METHOD PUBLIC VOID addDeliveryReceiptRecipient(INPUT ipcEmailAddress AS CHARACTER):
IF NOT CAN-FIND(FIRST ttDeliveryReceiptRecipients
WHERE ttDeliveryReceiptRecipients.cEmailAddress EQ ipcEmailAddress) THEN DO:
CREATE ttDeliveryReceiptRecipients.
ASSIGN ttDeliveryReceiptRecipients.cEmailAddress = ipcEmailAddress.
END.
END METHOD.
/* Add a delivery receipt recipient (with Real Name) to the email */
METHOD PUBLIC VOID addDeliveryReceiptRecipient(INPUT ipcEmailAddress AS CHARACTER,
INPUT ipcRealName AS CHARACTER):
IF NOT CAN-FIND(FIRST ttDeliveryReceiptRecipients
WHERE ttDeliveryReceiptRecipients.cEmailAddress EQ ipcEmailAddress) THEN DO:
CREATE ttDeliveryReceiptRecipients.
ASSIGN ttDeliveryReceiptRecipients.cEmailAddress = ipcEmailAddress
ttDeliveryReceiptRecipients.cRealName = ipcRealName.
END.
END METHOD.
/* Add a read receipt recipient to the email */
METHOD PUBLIC VOID addReadReceiptRecipient(INPUT ipcEmailAddress AS CHARACTER):
IF NOT CAN-FIND(FIRST ttReadReceiptRecipients
WHERE ttReadReceiptRecipients.cEmailAddress EQ ipcEmailAddress) THEN DO:
CREATE ttReadReceiptRecipients.
ASSIGN ttReadReceiptRecipients.cEmailAddress = ipcEmailAddress.
END.
END METHOD.
/* Add a read receipt recipient (with Real Name) to the email */
METHOD PUBLIC VOID addReadReceiptRecipient(INPUT ipcEmailAddress AS CHARACTER,
INPUT ipcRealName AS CHARACTER):
IF NOT CAN-FIND(FIRST ttReadReceiptRecipients
WHERE ttReadReceiptRecipients.cEmailAddress EQ ipcEmailAddress) THEN DO:
CREATE ttReadReceiptRecipients.
ASSIGN ttReadReceiptRecipients.cEmailAddress = ipcEmailAddress
ttReadReceiptRecipients.cRealName = ipcRealName.
END.
END METHOD.
/* Set the subject of the email */
METHOD PUBLIC VOID setSubject(INPUT ipcSubject AS CHARACTER):
ASSIGN cSubject = ipcSubject.
END METHOD.
/* Set the importance of the email. H = High, L = Low, anything else = Medium/None */
METHOD PUBLIC VOID setImportance(INPUT ipcImportance AS CHARACTER):
ASSIGN cImportance = ipcImportance.
END METHOD.
/* Set the sensitivity of the email. */
/* Possible values (from RFC 2156): "Personal", "Private", or "Company confidential" ("Company-confidential") */
METHOD PUBLIC VOID setSensitivity(INPUT ipcSensitivity AS CHARACTER):
ASSIGN cSensitivity = ipcSensitivity.
END METHOD.
/* Set the priority of the email (to affect transmission speed and delivery) */
/* Possible values (from RFC 2156): "normal", "urgent", or "non-urgent" */
METHOD PUBLIC VOID setPriority(INPUT ipcPriority AS CHARACTER):
ASSIGN cPriority = ipcPriority.
END METHOD.
/* Set the date/time the email was sent */
METHOD PUBLIC VOID setSentDate(INPUT ipdttmtzSentDate AS DATETIME-TZ):
ASSIGN dttmtzSentDate = ipdttmtzSentDate.
END METHOD.
/* Set the date/time recipient(s) should reply by */
METHOD PUBLIC VOID setReplyByDate(INPUT ipdttmtzReplyByDate AS DATETIME-TZ):
ASSIGN dttmtzReplyByDate = ipdttmtzReplyByDate.
END METHOD.
/* Set the date/time the message expires */
METHOD PUBLIC VOID setExpireDate(INPUT ipdttmtzExpireDate AS DATETIME-TZ):
ASSIGN dttmtzExpireDate = ipdttmtzExpireDate.
END METHOD.
/* If send email algorithm not set in constructor, you must set it using this method before the email can be sent */
METHOD PUBLIC VOID setSendEmailAlgorithm(INPUT ipobjSendEmailAlgorithm AS email.SendEmailAlgorithm):
ASSIGN objSendEmailAlgorithm = ipobjSendEmailAlgorithm.
END METHOD.
METHOD PUBLIC VOID setBodyText(INPUT ipcBodyText AS CHARACTER):
ASSIGN lcBody = ipcBodyText.
END METHOD.
METHOD PUBLIC VOID setBodyText(INPUT iplcBodyText AS LONGCHAR):
ASSIGN lcBody = iplcBodyText.
END METHOD.
/* Set the body by reading in an external file */
METHOD PUBLIC CHARACTER setBodyFile(INPUT ipcBodyFile AS CHARACTER):
FILE-INFO:FILE-NAME = ipcBodyFile.
IF FILE-INFO:FULL-PATHNAME EQ ? THEN
RETURN "Cannot locate file '" + ipcBodyFile + "' in the filesystem!".
IF INDEX(FILE-INFO:FILE-TYPE, "R") EQ 0 THEN
RETURN "File '" + FILE-INFO:FULL-PATHNAME + "' exists but is not readable!".
COPY-LOB FROM FILE FILE-INFO:FULL-PATHNAME TO OBJECT lcBody NO-ERROR.
IF ERROR-STATUS:ERROR THEN
RETURN "Error copying from file: " + ERROR-STATUS:GET-MESSAGE(1).
RETURN "". /* Success */
END METHOD.
/* Body defaults to base64 encoding, but can be manually disabled */
METHOD PUBLIC VOID setBodyEncoding(INPUT iplBase64Encode AS LOGICAL):
ASSIGN lBodyIsBase64 = iplBase64Encode.
END METHOD.
/* Add a non-encoded file attachment to the email */
METHOD PUBLIC CHARACTER addTextAttachment(INPUT ipcFileName AS CHARACTER):
DEFINE VARIABLE lcTemp AS LONGCHAR NO-UNDO.
FILE-INFO:FILE-NAME = ipcFileName.
IF FILE-INFO:FULL-PATHNAME EQ ? THEN
RETURN "Cannot locate file '" + ipcFileName + "' in the filesystem!".
IF INDEX(FILE-INFO:FILE-TYPE, "R") EQ 0 THEN
RETURN "File '" + FILE-INFO:FULL-PATHNAME + "' exists but is not readable!".
/* Load file into memory */
COPY-LOB FROM FILE FILE-INFO:FULL-PATHNAME TO OBJECT lcTemp NO-ERROR.
IF ERROR-STATUS:ERROR THEN
RETURN "Error copying from file: " + ERROR-STATUS:GET-MESSAGE(1).
CREATE ttAttachments.
ASSIGN ttAttachments.cFileName = ipcFileName
ttAttachments.lcData = NEW email.LongcharWrapper(lcTemp)
ttAttachments.lBase64Encode = FALSE.
RETURN "". /* Success */
END.
/* Add a file attachment to the email; it defaults to base-64 encoding */
METHOD PUBLIC CHARACTER addAttachment(INPUT ipcFileName AS CHARACTER):
DEFINE VARIABLE lcTemp AS LONGCHAR NO-UNDO.
FILE-INFO:FILE-NAME = ipcFileName.
IF FILE-INFO:FULL-PATHNAME EQ ? THEN
RETURN "Cannot locate file '" + ipcFileName + "' in the filesystem!".
IF INDEX(FILE-INFO:FILE-TYPE, "R") EQ 0 THEN
RETURN "File '" + FILE-INFO:FULL-PATHNAME + "' exists but is not readable!".
/* Load file into memory */
COPY-LOB FROM FILE FILE-INFO:FULL-PATHNAME TO OBJECT lcTemp NO-ERROR.
IF ERROR-STATUS:ERROR THEN
RETURN "Error copying from file: " + ERROR-STATUS:GET-MESSAGE(1).
CREATE ttAttachments.
ASSIGN ttAttachments.cFileName = ipcFileName
ttAttachments.lcData = NEW email.LongcharWrapper(EmailClient.Util:ConvertDataToBase64(lcTemp))
ttAttachments.lBase64Encode = TRUE.
RETURN "". /* Success */
END.
/* Override default MIME boundary */
METHOD PUBLIC VOID setMimeBoundary(INPUT ipcMimeBoundary AS CHARACTER):
ASSIGN cMimeBoundary = ipcMimeBoundary.
END METHOD.
/* Return a concatenated list of To:, CC:, and BCC: recipients */
METHOD PUBLIC CHARACTER getRecipients():
DEFINE VARIABLE cRecipients AS CHARACTER NO-UNDO.
FOR EACH ttToRecipients
BREAK BY ttToRecipients.cEmailAddress:
ASSIGN cRecipients = cRecipients + ttToRecipients.cEmailAddress.
IF NOT LAST(ttToRecipients.cEmailAddress) THEN DO:
ASSIGN cRecipients = cRecipients + ", ".
END.
END.
FOR EACH ttCCRecipients
BREAK BY ttCCRecipients.cEmailAddress:
IF FIRST(ttCCRecipients.cEmailAddress) AND
cRecipients NE "" THEN
ASSIGN cRecipients = cRecipients + ", ".
ASSIGN cRecipients = cRecipients + ttCCRecipients.cEmailAddress.
IF NOT LAST(ttCCRecipients.cEmailAddress) THEN
ASSIGN cRecipients = cRecipients + ttCCRecipients.cEmailAddress.
END.
FOR EACH ttBCCRecipients
BREAK BY ttBCCRecipients.cEmailAddress:
IF FIRST(ttBCCRecipients.cEmailAddress) AND
cRecipients NE "" THEN
ASSIGN cRecipients = cRecipients + ", ".
ASSIGN cRecipients = cRecipients + ttBCCRecipients.cEmailAddress.
IF NOT LAST(ttBCCRecipients.cEmailAddress) THEN
ASSIGN cRecipients = cRecipients + ttBCCRecipients.cEmailAddress.
END.
RETURN cRecipients.
END METHOD.
/* Dumps all email message headers to CHAR */
METHOD PUBLIC CHARACTER getHeaders():
DEFINE VARIABLE cReturnData AS CHARACTER NO-UNDO.
/* Write the "From:" header */
ASSIGN cReturnData = cReturnData + {&QUOTES} + "From:".
FOR EACH ttSenders
BREAK BY ttSenders.cEmailAddress:
IF ttSenders.cRealName NE ? THEN
ASSIGN cReturnData = cReturnData + ttSenders.cRealName + " <" + ttSenders.cEmailAddress + ">".
ELSE
ASSIGN cReturnData = cReturnData + ttSenders.cEmailAddress.
IF NOT LAST(ttSenders.cEmailAddress) THEN
ASSIGN cReturnData = cReturnData + ", ".
END.
ASSIGN cReturnData = cReturnData + {&QUOTES} + "\n".
/* Write the "To:" header */
ASSIGN cReturnData = cReturnData + {&QUOTES} + "To:".
FOR EACH ttToRecipients
BREAK BY ttToRecipients.cEmailAddress:
IF ttToRecipients.cRealName NE ? THEN
ASSIGN cReturnData = cReturnData + ttToRecipients.cRealName + " <" + ttToRecipients.cEmailAddress + ">".
ELSE
ASSIGN cReturnData = cReturnData + ttToRecipients.cEmailAddress.
IF NOT LAST(ttToRecipients.cEmailAddress) THEN
ASSIGN cReturnData = cReturnData + ", ".
END.
ASSIGN cReturnData = cReturnData + {&QUOTES} + "\n".
/* Write the "Reply-To:" header */
ASSIGN cReturnData = cReturnData + {&QUOTES} + "Reply-To:".
IF TEMP-TABLE ttReplyToRecipients:HAS-RECORDS THEN DO:
/* Use manually-overridden reply-to addresses */
FOR EACH ttReplyToRecipients
BREAK BY ttReplyToRecipients.cEmailAddress:
IF ttReplyToRecipients.cRealName NE ? THEN
ASSIGN cReturnData = cReturnData + ttReplyToRecipients.cRealName + " <" + ttReplyToRecipients.cEmailAddress + ">".
ELSE
ASSIGN cReturnData = cReturnData + ttReplyToRecipients.cEmailAddress.
IF NOT LAST(ttReplyToRecipients.cEmailAddress) THEN
ASSIGN cReturnData = cReturnData + ", ".
END. /* FOR EACH ttReplyToRecipients ... */
END. /* IF TEMP-TABLE ttReplyToRecipients:HAS-RECORDS */
ELSE DO:
/* Write reply-to using sender addresses if reply-to addresses not manually overriddden */
FOR EACH ttSenders
BREAK BY ttSenders.cEmailAddress:
IF ttSenders.cRealName NE ? THEN
ASSIGN cReturnData = cReturnData + ttSenders.cRealName + " <" + ttSenders.cEmailAddress + ">".
ELSE
ASSIGN cReturnData = cReturnData + ttSenders.cEmailAddress.
IF NOT LAST(ttSenders.cEmailAddress) THEN
ASSIGN cReturnData = cReturnData + ", ".
END.
END. /* ELSE / IF TEMP-TABLE ttReplyToRecipients:HAS-RECORDS */
ASSIGN cReturnData = cReturnData + {&QUOTES} + "\n".
/* Write the "Cc:" header */
ASSIGN cReturnData = cReturnData + {&QUOTES} + "Cc:".
FOR EACH ttCCRecipients
BREAK BY ttCCRecipients.cEmailAddress:
IF ttCCRecipients.cRealName NE ? THEN
ASSIGN cReturnData = cReturnData + ttCCRecipients.cRealName + " <" + ttCCRecipients.cEmailAddress + ">".
ELSE
ASSIGN cReturnData = cReturnData + ttCCRecipients.cEmailAddress.
IF NOT LAST(ttCCRecipients.cEmailAddress) THEN
ASSIGN cReturnData = cReturnData + ", ".
END.
ASSIGN cReturnData = cReturnData + {&QUOTES} + "\n".
/* Write the "Bcc:" header */
ASSIGN cReturnData = cReturnData + {&QUOTES} + "Bcc:".
FOR EACH ttBCCRecipients
BREAK BY ttBCCRecipients.cEmailAddress:
IF ttBCCRecipients.cRealName NE ? THEN
ASSIGN cReturnData = cReturnData + ttBCCRecipients.cRealName + " <" + ttBCCRecipients.cEmailAddress + ">".
ELSE
ASSIGN cReturnData = cReturnData + ttBCCRecipients.cEmailAddress.
IF NOT LAST(ttBCCRecipients.cEmailAddress) THEN
ASSIGN cReturnData = cReturnData + ", ".
END.
ASSIGN cReturnData = cReturnData + {&QUOTES} + "\n".
/* If delivery recipients specified, write each recipient out */
IF TEMP-TABLE ttDeliveryReceiptRecipients:HAS-RECORDS THEN DO:
ASSIGN cReturnData = cReturnData + {&QUOTES} + "Return-Receipt-To:".
FOR EACH ttDeliveryReceiptRecipients
BREAK BY ttDeliveryReceiptRecipients.cEmailAddress:
IF ttDeliveryReceiptRecipients.cRealName NE ? THEN
ASSIGN cReturnData = cReturnData + ttDeliveryReceiptRecipients.cRealName + " <" + ttDeliveryReceiptRecipients.cEmailAddress + ">".
ELSE
ASSIGN cReturnData = cReturnData + ttDeliveryReceiptRecipients.cEmailAddress.
IF NOT LAST(ttDeliveryReceiptRecipients.cEmailAddress) THEN
ASSIGN cReturnData = cReturnData + ", ".
END. /* FOR EACH ttDeliveryReceiptRecipients */
ASSIGN cReturnData = cReturnData + {&QUOTES}.
END. /* IF TEMP-TABLE ttDeliveryReceiptRecipients:HAS-RECORDS */
/* If read recipients specified, write each recipient out */
IF TEMP-TABLE ttReadReceiptRecipients:HAS-RECORDS THEN DO:
ASSIGN cReturnData = cReturnData + {&QUOTES} + "Disposition-Notification-To:".
FOR EACH ttReadReceiptRecipients
BREAK BY ttReadReceiptRecipients.cEmailAddress:
IF ttReadReceiptRecipients.cRealName NE ? THEN
ASSIGN cReturnData = cReturnData + ttReadReceiptRecipients.cRealName + " <" + ttReadReceiptRecipients.cEmailAddress + ">".
ELSE
ASSIGN cReturnData = cReturnData + ttReadReceiptRecipients.cEmailAddress.
IF NOT LAST(ttReadReceiptRecipients.cEmailAddress) THEN
ASSIGN cReturnData = cReturnData + ", ".
END. /* FOR EACH ttReadReceiptRecipients */
ASSIGN cReturnData = cReturnData + {&QUOTES}.
END. /* IF TEMP-TABLE ttReadReceiptRecipients:HAS-RECORDS */
/* Write the "Subject:" header */
ASSIGN cReturnData = cReturnData + "\n" + {&QUOTES} + "Subject:" + cSubject + {&QUOTES}.
/* Write the "Importance:" header */
IF cImportance BEGINS "H" THEN
ASSIGN cReturnData = cReturnData + "\n" + {&QUOTES} + "Importance:High" + {&QUOTES}.
ELSE IF cImportance BEGINS "L" THEN
ASSIGN cReturnData = cReturnData + "\n" + {&QUOTES} + "Importance:Low" + {&QUOTES}.
/* Write the "Sensitivity" header */
IF cSensitivity NE "" THEN
ASSIGN cReturnData = cReturnData + "\n" + {&QUOTES} + "Sensitivity:" + cSensitivity + {&QUOTES}.
/* Write the "Priority" header */
IF cPriority NE "" THEN
ASSIGN cReturnData = cReturnData + "\n" + {&QUOTES} + "Priority:" + cPriority + {&QUOTES}.
/* Write the "Date" (sent date) header */
IF dttmtzSentDate NE ? THEN
ASSIGN cReturnData = cReturnData + "\n" + {&QUOTES} + "Date:" + email.Util:ABLDateTimeToEmail(dttmtzSentDate) + {&QUOTES}.
IF dttmtzReplyByDate NE ? THEN
ASSIGN cReturnData = cReturnData + "\n" + {&QUOTES} + "Reply-By:" + email.Util:ABLDateTimeToEmail(dttmtzReplyByDate) + {&QUOTES}.
/* Write the "Expiry-Date" header */
IF dttmtzExpireDate NE ? THEN
ASSIGN cReturnData = cReturnData + "\n" + {&QUOTES} + "Expiry-Date:" + email.Util:ABLDateTimeToEmail(dttmtzExpireDate) + {&QUOTES}.
RETURN cReturnData.
END METHOD.
/* Dumps all email message payload data (body and attachments) to LONGCHAR */
METHOD PUBLIC LONGCHAR getPayload():
DEFINE VARIABLE lcReturnData AS LONGCHAR NO-UNDO.
/* If no body and no text, then return empty string ("") */
IF lcBody EQ "" AND NOT TEMP-TABLE ttAttachments:HAS-RECORDS THEN
RETURN lcReturnData.
/* Write payload header */
ASSIGN lcReturnData = "Mime-Version: 1.0" + cNewLine +
"Content-Type: multipart/mixed; boundary=" + cMimeBoundary + cNewLine + cNewLine.
/* Write out the email body, if it exists */
IF lcBody NE "" THEN DO:
ASSIGN lcReturnData = lcReturnData + "--" + cMimeBoundary + cNewLine +
"Content-Type: text/plain; charset=~"us-ascii~"" + cNewLine.
IF lBodyIsBase64 THEN DO:
ASSIGN lcReturnData = lcReturnData + "Content-Transfer-Encoding: base64" + cNewLine +
cNewLine +
email.Util:ConvertDataToBase64(lcBody) + cNewLine.
END.
ELSE DO:
ASSIGN lcReturnData = lcReturnData + "Content-Transfer-Encoding: 7bit" + cNewLine +
cNewLine +
lcBody + cNewLine.
END.
END.
/* Write out each email attachment */
FOR EACH ttAttachments:
ASSIGN lcReturnData = lcReturnData + "--" + cMimeBoundary + cNewLine.
IF ttAttachments.lBase64Encode THEN DO:
ASSIGN lcReturnData = lcReturnData + "Content-Type: application/octet-stream" + cNewLine +
"Content-Disposition: attachment; filename=~"" + ttAttachments.cFileName + "~"" + cNewLine +
"Content-Transfer-Encoding: base64" + cNewLine + cNewLine +
CAST(ttAttachments.lcData, email.LongcharWrapper):getLongchar() + cNewLine.
END.
ELSE DO:
ASSIGN lcReturnData = lcReturnData + "Content-Type: text/plain; charset=~"us-ascii~"" + cNewLine +
"Content-Disposition: attachment; filename=~"" + ttAttachments.cFileName + "~"" + cNewLine +
"Content-Transfer-Encoding: 7bit" + cNewLine + cNewLine +
CAST(ttAttachments.lcData, email.LongcharWrapper):getLongchar() + cNewLine.
END.
END.
/* Write payload footer */
ASSIGN lcReturnData = lcReturnData + "--" + cMimeBoundary + "--" + cNewLine.
RETURN lcReturnData.
END METHOD.
METHOD PUBLIC CHARACTER send():
RETURN objSendEmailAlgorithm:sendEmail(INPUT THIS-OBJECT).
END METHOD.
END CLASS.

240
test/fixtures/cApplication.cls vendored Normal file
View File

@@ -0,0 +1,240 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "cApplication"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'*************************************************************************************************************************************************************************************************************************************************
'
' Copyright (c) David Briant 2009-2012 - All rights reserved
'
'*************************************************************************************************************************************************************************************************************************************************
Option Explicit
Private Declare Function apiSetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function apiGlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As Long
Private Declare Function apiSetForegroundWindow Lib "user32" Alias "SetForegroundWindow" (ByVal hwnd As Long) As Long
Private myMouseEventsForm As fMouseEventsForm
Private WithEvents myAST As cTP_AdvSysTray
Attribute myAST.VB_VarHelpID = -1
Private myClassName As String
Private myWindowName As String
Private Const TEN_MILLION As Single = 10000000
Private WithEvents myListener As VLMessaging.VLMMMFileListener
Attribute myListener.VB_VarHelpID = -1
Private WithEvents myMMFileTransports As VLMessaging.VLMMMFileTransports
Attribute myMMFileTransports.VB_VarHelpID = -1
Private myMachineID As Long
Private myRouterSeed As Long
Private myRouterIDsByMMTransportID As New Dictionary
Private myMMTransportIDsByRouterID As New Dictionary
Private myDirectoryEntriesByIDString As New Dictionary
Private Const GET_ROUTER_ID As String = "GET_ROUTER_ID"
Private Const GET_ROUTER_ID_REPLY As String = "GET_ROUTER_ID_REPLY"
Private Const REGISTER_SERVICE As String = "REGISTER_SERVICE"
Private Const REGISTER_SERVICE_REPLY As String = "REGISTER_SERVICE_REPLY"
Private Const UNREGISTER_SERVICE As String = "UNREGISTER_SERVICE"
Private Const UNREGISTER_SERVICE_REPLY As String = "UNREGISTER_SERVICE_REPLY"
Private Const GET_SERVICES As String = "GET_SERVICES"
Private Const GET_SERVICES_REPLY As String = "GET_SERVICES_REPLY"
'*************************************************************************************************************************************************************************************************************************************************
' Initialize / Release
'*************************************************************************************************************************************************************************************************************************************************
Private Sub class_Initialize()
Dim atomID As Long
Randomize
' hide us from the Applications list in the Windows Task Manager
App.TaskVisible = False
' listen for connections
myClassName = "VLMMachineRouter" & CStr(Int(Rnd() * TEN_MILLION) + 1)
Randomize
myWindowName = "VLMMachineRouter" & CStr(Int(Rnd() * TEN_MILLION) + 1)
Set myListener = New VLMMMFileListener
myListener.listenViaNamedWindow myClassName, myWindowName, 1024 * 8
Set myMMFileTransports = New VLMMMFileTransports
myRouterSeed = 1
' create tray icon
Set myMouseEventsForm = New fMouseEventsForm
Set myAST = New cTP_AdvSysTray
myAST.create myMouseEventsForm, myMouseEventsForm.icon, "VLM Directory"
'myAST.showBalloon "Current Shell32.dll version is " & myAST.shellVersion & ".x", "AdvSysTray VB Class", NIIF_INFO
' make myself easily found
apiSetProp myMouseEventsForm.hwnd, "IsVLMachineRouter", 1
apiSetProp myMouseEventsForm.hwnd, "WindowNameAtom", apiGlobalAddAtom(myWindowName)
apiSetProp myMouseEventsForm.hwnd, "ClassNameAtom", apiGlobalAddAtom(myClassName)
End Sub
Sub shutdown()
myAST.destroy
Set myAST = Nothing
Unload myMouseEventsForm
Set myMouseEventsForm = Nothing
End Sub
Private Sub myAST_RButtonUp()
Dim epm As New cTP_EasyPopupMenu, menuItemSelected As Long
'SetForegroundWindow myMouseEventsForm.hwnd
' epm.addMenuItem "Main form...", MF_STRING, 1
' epm.createSubmenu "Radio items"
' epm.addSubmenuItem "Radio item 1", MF_STRING, 2
' epm.addSubmenuItem "Radio item 2", MF_STRING, 3
' epm.addSubmenuItem "Radio item 3", MF_STRING, 4
' epm.checkRadioItem 0, 2, 1
' epm.addMenuItem "", MF_SEPARATOR, 0
' epm.addMenuItem "Disabled item", MF_GRAYED, 5
' epm.addMenuItem "Checked item", MF_CHECKED, 6
' epm.addMenuItem "", MF_SEPARATOR, 0
epm.addMenuItem "Exit", MF_STRING, 12
apiSetForegroundWindow myMouseEventsForm.hwnd
menuItemSelected = epm.trackMenu(myMouseEventsForm.hwnd)
Select Case menuItemSelected
Case 12
Set epm = Nothing
globalShutdown
End Select
End Sub
Private Sub myListener_newConnection(ByVal newTransport As VLMessaging.VLMMMFileTransport, oReceived As Boolean)
Dim id As Long
oReceived = True
id = myMMFileTransports.addTransport(newTransport)
End Sub
Private Function messageFromBytes(buffer() As Byte) As VLMMessage
Dim i1 As Long, i2 As Long, messageArray As Variant, message As New VLMMessage
DBGetArrayBounds buffer, 1, i1, i2
messageArray = g_VLMUtils.BytesAsVariant(buffer, i2 + 1, 1)
message.fromMessageArray messageArray
Set messageFromBytes = message
End Function
Private Function messageToBytes(message As VLMMessage) As Byte()
Dim messageArray As Variant, length As Long, buffer() As Byte
message.toMessageArray messageArray
length = g_VLMUtils.LengthOfVariantAsBytes(messageArray)
DBCreateNewArrayOfBytes buffer, 1, length
g_VLMUtils.VariantAsBytes messageArray, buffer, length + 1, 1
messageToBytes = buffer
End Function
Private Sub myMMFileTransports_bytesArrived(ByVal id As Long, buffer() As Byte, oReceived As Boolean)
Dim message As VLMMessage, toAddress As VLMAddress
oReceived = True
Set message = messageFromBytes(buffer)
Set toAddress = message.toAddress
On Error GoTo errorHandler
If (toAddress.MachineID = myMachineID Or toAddress.MachineID = 0) And toAddress.RouterID = 1 And toAddress.AgentID = 1 Then
handleMessageToRouter id, message
Else
routeMessage message
End If
Exit Sub
errorHandler:
MsgBox Err.Description & ", " & Erl
End Sub
Sub handleMessageToRouter(MMFileTransportID As Long, message As VLMMessage)
Dim reply As VLMMessage, transport As VLMMMFileTransport, RouterID As Long, address As New VLMAddress
Dim IDString As String, vs As Variant, i As Long, entries As New Collection, answer1D As Variant
Select Case True
Case message.subject = GET_ROUTER_ID
If myRouterIDsByMMTransportID.Exists(MMFileTransportID) Then
RouterID = myRouterIDsByMMTransportID(MMFileTransportID)
Else
myRouterSeed = myRouterSeed + 1
RouterID = myRouterSeed
myRouterIDsByMMTransportID(MMFileTransportID) = RouterID
myMMTransportIDsByRouterID(RouterID) = MMFileTransportID
End If
Set reply = message.reply
reply.subject = GET_ROUTER_ID_REPLY
reply.Contents = RouterID
Set transport = myMMFileTransports.transport(MMFileTransportID)
transport.send messageToBytes(reply)
Case message.subject = REGISTER_SERVICE
address.initialise CLng(message.Contents(1)(1)), CLng(message.Contents(1)(2)), CLng(message.Contents(1)(3))
myDirectoryEntriesByIDString(directoryEntryIDString(CStr(message.Contents(2)), address)) = message.Contents
Set reply = message.reply
reply.subject = REGISTER_SERVICE_REPLY
Set transport = myMMFileTransports.transport(MMFileTransportID)
transport.send messageToBytes(reply)
Case message.subject = UNREGISTER_SERVICE
address.initialise CLng(message.Contents(1)(1)), CLng(message.Contents(1)(2)), CLng(message.Contents(1)(3))
IDString = directoryEntryIDString(CStr(message.Contents(2)), address)
If myDirectoryEntriesByIDString.Exists(IDString) Then myDirectoryEntriesByIDString.Remove IDString
Set reply = message.reply
reply.subject = UNREGISTER_SERVICE_REPLY
Set transport = myMMFileTransports.transport(MMFileTransportID)
transport.send messageToBytes(reply)
Case message.subject = GET_SERVICES
vs = myDirectoryEntriesByIDString.Items
For i = 0 To UBound(vs)
If IsEmpty(message.Contents) Then
entries.Add vs(i)
Else
If vs(i)(2) = message.Contents Then entries.Add vs(i)
End If
Next
If entries.Count > 0 Then
ReDim answer1D(1 To entries.Count)
For i = 1 To entries.Count
answer1D(i) = entries(i)
Next
End If
Set reply = message.reply
reply.subject = GET_SERVICES_REPLY
reply.Contents = answer1D
Set transport = myMMFileTransports.transport(MMFileTransportID)
transport.send messageToBytes(reply)
End Select
End Sub
Sub routeMessage(message As VLMMessage)
Dim buffer() As Byte, transport As VLMMMFileTransport
If message.toAddress.MachineID <> 0 And message.toAddress.MachineID <> myMachineID Then
' route to a remote machine
Else
' for the moment just route between MMFileTransports
If myMMTransportIDsByRouterID.Exists(message.toAddress.RouterID) Then
Set transport = myMMFileTransports(myMMTransportIDsByRouterID(message.toAddress.RouterID))
transport.send messageToBytes(message)
End If
End If
End Sub
Function directoryEntryIDString(serviceType As String, address As VLMAddress)
directoryEntryIDString = serviceType & "<" & address.MachineID & "," & address.RouterID & "," & address.AgentID & ">"
End Function
Private Sub myMMFileTransports_disconnecting(ByVal id As Long, oReceived As Boolean)
oReceived = True
End Sub

8
test/fixtures/latex.cls vendored
View File

@@ -1,8 +0,0 @@
% latex.cls
%
% A barebones LaTeX2e class file
\def\author{Abe Voelker}
\def\fileversion{0.1}
\NeedsTeXFormat{LaTeX2e}

10
test/fixtures/openedge.cls vendored
View File

@@ -1,10 +0,0 @@
USING Progress.Lang.*.
CLASS HelloWorld:
CONSTRUCTOR PUBLIC HelloWorld():
SUPER().
MESSAGE "Hello, world!".
END CONSTRUCTOR.
END CLASS.

245
test/fixtures/reedthesis.cls vendored Normal file
View File

@@ -0,0 +1,245 @@
%
% This file is copyright (C) 2003 Sam Noble. It may be modified so long
% as my name is not removed and the modifier adds his name to the file.
% Redistribution permitted.
%
% 27 Jan 2004 Sam Noble Removed tocbibind dependency.
% 04 Dec 2001 Sam Noble Class file
% 03 Sep 1995 David Perkinson Title Page
% Acknowledgements Page, David Perkinson & Sam Noble
% May 2005 Patrick Carlisle Table of contents chapter definition
% 2004-2005 Ben Salzberg (BTS) a variety of tweaks here and in the template
%
% Oddities:
%
% We *ASSUME* that any time \cleardoublepage is called
% we actually want a blank back side with NO page number/heading
%
% Minor bug -- seems to be a more general LaTeX thing:
% If you use \frontmatter \mainmatter without any chapters inbetween
% be prepared to have the page numbering messed up. Not a big deal,
% but I'm not sure how to fix it.
%
%
\NeedsTeXFormat{LaTeX2e}
\ProvidesClass{reedthesis}[2004/01/27 The Reed College Thesis Class]
\DeclareOption*{\PassOptionsToClass{\CurrentOption}{book}}
\ProcessOptions\relax
\LoadClass{book}
\RequirePackage{fancyhdr}
% This gives us rules below the headers
\AtBeginDocument{%
\fancyhf{}
\fancyhead[LE,RO]{\thepage}
% \fancyhead[RE]{\slshape \leftmark}
% \fancyhead[LO]{\slshape \rightmark}
% The above makes your headers in all caps. If you would like different headers, choose one of the following options (be sure to remove the % symbol from both the right and left headers):
\fancyhead[RE]{\slshape \nouppercase \leftmark} % This makes the headers on the RIGHT side pages be italic and use lowercase With Capitals When Specified.
\fancyhead[LO]{\slshape \nouppercase \rightmark} % This does the same thing to the LEFT side pages
% or
% \fancyhead[RE]{\scshape \leftmark} % The RIGHT headers will be in small caps.
% \fancyhead[LO]{\scshape \rightmark} % And so will the LEFT headers
\pagestyle{fancy}
% Psych majors: You do not need the following six lines, as it conflicts with apacite, so comment them out.
\let\oldthebibliography=\thebibliography
\let\endoldthebibliography=\endthebibliography
\renewenvironment{thebibliography}[1]{
\oldthebibliography{#1}
\addcontentsline{toc}{chapter}{\bibname}
}{\endoldthebibliography}
%%%%%% end of things for psych majors to comment out
\let\oldtheindex=\theindex
\let\endoldtheindex=\endtheindex
\renewenvironment{theindex}{
\oldtheindex
\addcontentsline{toc}{chapter}{\indexname}
}{\endoldtheindex}
}
% Stolen from book.cls and modified
\let\RToldchapter\chapter
\renewcommand{\chapter}{\if@openright\RTcleardoublepage
\else\clearpage\fi
\thispagestyle{empty}%
\global\@topnum\z@
\@afterindentfalse
\secdef\@chapter\@schapter}
% Stolen from book.cls PBC 5/12/05
% Using this to actually show "Chapter 1" in TOC instead of "1"
\def\@chapter[#1]#2{\ifnum \c@secnumdepth >\m@ne
\if@mainmatter
\refstepcounter{chapter}%
\typeout{\@chapapp\space\thechapter.}%
\addcontentsline{toc}{chapter}%
{\@chapapp\space\thechapter:\space#1}%
\else
\addcontentsline{toc}{chapter}{#1}%
\fi
\else
\addcontentsline{toc}{chapter}{#1}%
\fi
\chaptermark{#1}%
\addtocontents{lof}{\protect\addvspace{10\p@}}%
\addtocontents{lot}{\protect\addvspace{10\p@}}%
\if@twocolumn
\@topnewpage[\@makechapterhead{#2}]%
\else
\@makechapterhead{#2}%
\@afterheading
\fi}
\newcommand{\RTcleardoublepage}{
\clearpage\if@twoside \ifodd\c@page\else
\thispagestyle{empty}\hbox{}\newpage
\if@twocolumn\hbox{}\newpage\fi\fi\fi}
\let\RToldcleardoublepage\cleardoublepage
\renewcommand{\cleardoublepage}{\RTcleardoublepage}
% adjust margins for binding (changed 2007-04-24 tgp)
\setlength{\oddsidemargin}{.5in}
\setlength{\evensidemargin}{0in}
\setlength{\textwidth}{6.0in}
\setlength{\textheight}{9.0in}
\setlength\topmargin{0in}
\addtolength\topmargin{-\headheight}
\addtolength\topmargin{-\headsep}
%\setlength{\oddsidemargin}{.6in}
%\setlength{\evensidemargin}{0in}
%\setlength{\textwidth}{5.9in}
%\setlength\topmargin{0in}
%\addtolength\headheight{2.5pt}
%\addtolength\topmargin{-\headheight}
%\addtolength\topmargin{-\headsep}
%\addtolength\textheight{1in}
%\addtolength\textheight{\headheight}
%\addtolength\textheight{\headsep}
\def\division#1{\gdef \@division{#1}}
\def\@division{\@latex@warning@no@line{No \noexpand\division given}}
\def\department#1{\gdef \@department{#1}}
\def\@department{\@latex@warning@no@line{No \noexpand\department given}}
\def\thedivisionof#1{\gdef \@thedivisionof{#1}}
\def\@thedivisionof{The Division of}
\def\approvedforthe#1{\gdef \@approvedforthe{#1}}
\def\@approvedforthe{Division}
\def\advisor#1{\gdef \@advisor{#1}}
\def\@advisor{\@latex@warning@no@line{No \noexpand\advisor given}}
\def\altadvisor#1{\gdef \@altadvisor{#1} \@altadvisortrue}
\global\let\@altadvisor\@empty
\newif\if@altadvisor
\@altadvisorfalse
\renewcommand{\contentsname}{Table of Contents}
\renewcommand{\bibname}{References}
\renewcommand\l@chapter[2]{%
\ifnum \c@tocdepth >\m@ne
\addpenalty{-\@highpenalty}%
\vskip 1.0em \@plus\p@
\setlength\@tempdima{1.5em}%
\begingroup
\parindent \z@ \rightskip \@pnumwidth
\parfillskip -\@pnumwidth
\leavevmode \bfseries
\advance\leftskip\@tempdima
\hskip -\leftskip
#1\nobreak\normalfont
\leaders\hbox{$\m@th \mkern \@dotsep mu\hbox{.}\mkern \@dotsep mu$}\hfill
\nobreak\hb@xt@\@pnumwidth{\bfseries \hss #2}\par
\penalty\@highpenalty
\endgroup
\fi}
\newenvironment{abstract}{%
\if@twocolumn
\@restonecoltrue\onecolumn
\else
\@restonecolfalse
\fi
\chapter[Abstract]{}
\begin{center}
{\fontsize{14}{16}\selectfont \bfseries Abstract}
\end{center}
\fontsize{12}{14}\selectfont
}{\clearpage \if@restonecol\twocolumn\fi}%
\ifx\@pdfoutput\@undefined
\newcommand{\RTpercent}{\@percentchar\space}
\AtBeginDvi{\special{!\RTpercent Reed College LaTeX Thesis Class 2001/12/04 SN}}
\AtBeginDvi{\special{rawpostscript \RTpercent Reed College LaTeX Thesis Class 2001/12/04 SN}}
\else
\AtEndDocument{\pdfinfo{/Creator (Reed College LaTeX Thesis Class 2001/12/04 SN)}}
\fi
% I hacked the title page to all be the same font size
% as requested by the library, BTS 2005
\renewcommand{\maketitle}{%
{\pagestyle{empty}
\fontsize{12}{14}\selectfont
\begin{titlepage}
\newpage
\let\footnotesize\small
\let\footnoterule\relax
\let \footnote \thanks
\baselineskip = 1.4\baselineskip
\setbox0=\hbox{of the Requirements for the Degree}
\begin{center}
\setcounter{page}{1}
\null\vfil
{\fontsize{12}{14}\selectfont \@title}
\vfil
\centerline{\hbox to \wd0 {\hbox{}\hrulefill\hbox{}}}
\vfil
A Thesis \\
Presented to \\
\@thedivisionof \ \@division \\
Reed College
\vfil
\centerline{\hbox to \wd0 {\hbox{}\hrulefill\hbox{}}}
\vfil
In Partial Fulfillment \\
of the Requirements for the Degree \\
Bachelor of Arts
\vfil
\centerline{\hbox to \wd0 {\hbox{}\hrulefill\hbox{}}}
\bigskip
\centerline{}
\bigskip
{\fontsize{12}{14}\selectfont \lineskip .75em
\begin{tabular}[t]{c}%
\@author
\end{tabular}\par}
\vskip 1.5em
{\fontsize{12}{14}\selectfont \@date \par}
\end{center}\par
\end{titlepage}
%% Approved for the division page
\cleardoublepage
{\fontsize{12}{14}
\setbox0=\hbox{Approved for the \@approvedforthe}
\thispagestyle{empty}
\null\vfil % just below center of page
\par\vskip 6cm % below center, not center
\centerline{\copy0} % approved
\centerline{(\@department)} %major
\vskip 1cm %space to sign
\centerline{\makebox[\wd0][c]{\hrulefill}
\if@altadvisor \makebox[.5in]{} \makebox[\wd0][c]{\hrulefill} \fi}
\centerline{\makebox[\wd0][c]{\@advisor}
\if@altadvisor \makebox[.5in]{} \makebox[\wd0][c]{\@altadvisor} \fi}
\par\vfil\null}
\cleardoublepage
}
}

10
test/test_blob.rb
View File

@@ -288,8 +288,14 @@ class TestBlob < Test::Unit::TestCase
assert_nil blob("octocat.png").language
# .cls disambiguation
assert_equal Language['OpenEdge ABL'], blob("openedge.cls").language
assert_equal Language['TeX'], blob("latex.cls").language
# https://github.com/abevoelker/abl-email-client/blob/master/com/abevoelker/email/Email.cls
assert_equal Language['OpenEdge ABL'], blob("Email.cls").language
# https://github.com/emcmanis/Thesis/blob/master/TeX/Thesis%20Template/reedthesis.cls
assert_equal Language['TeX'], blob("reedthesis.cls").language
# https://github.com/DangerMouseB/VLMessaging/blob/master/VLMMachineRouter/cApplication.cls
assert_equal Language['Visual Basic'], blob("cApplication.cls").language
# https://github.com/apex-commons/base/blob/master/src/classes/ArrayUtils.cls
assert_equal Language['Apex'], blob("ArrayUtils.cls").language
# .pl disambiguation
assert_equal Language['Prolog'], blob("test-prolog.pl").language

2
test/test_language.rb
View File

@@ -10,7 +10,7 @@ class TestLanguage < Test::Unit::TestCase
def test_ambiguous_extensions
assert Language.ambiguous?('.cls')
assert_equal Language['OpenEdge ABL'], Language.find_by_extension('cls')
assert_equal Language['TeX'], Language.find_by_extension('cls')
assert Language.ambiguous?('.h')
assert_equal Language['C'], Language.find_by_extension('h')