From: Christopher Piro Date: Wed, 18 Jul 2007 00:26:12 +0000 (+0000) Subject: [thrift] highly concurrent Erlang goodness X-Git-Tag: 0.2.0~1308 X-Git-Url: https://source.supwisdom.com/gerrit/gitweb?a=commitdiff_plain;h=094823a46c4dd2449ec4ec9458b8358f8abd3dbe;p=common%2Fthrift.git [thrift] highly concurrent Erlang goodness Summary: * shim to use object-oriented code as gen_servers * high(er) performance Erlang-style server and transport * sane packaging based on otp-base, i.e. Makefiles and real structure Test Plan: tutorial server offers the same (subset of) functionality as previous version Revert Plan: ok git-svn-id: https://svn.apache.org/repos/asf/incubator/thrift/trunk@665164 13f79535-47bb-0310-9956-ffa450edef68 --- diff --git a/compiler/cpp/src/generate/t_erl_generator.cc b/compiler/cpp/src/generate/t_erl_generator.cc index ff2e2872..4407cf51 100644 --- a/compiler/cpp/src/generate/t_erl_generator.cc +++ b/compiler/cpp/src/generate/t_erl_generator.cc @@ -9,13 +9,12 @@ #include #include #include "t_erl_generator.h" -using namespace std; +using namespace std; void hrl_header(std::ostream& out, std::string name); void hrl_footer(std::ostream& out, std::string name); - /** * UI for file generation by opening up the necessary file output * streams. @@ -99,8 +98,9 @@ string t_erl_generator::erl_autogen_comment() { */ string t_erl_generator::erl_imports() { return - string("-include(\"thrift/protocol/tProtocol.hrl\").\n") + - "-include(\"thrift/thrift.hrl\")."; + string("-include(\"thrift.hrl\").\n") + + "-include(\"tApplicationException.hrl\").\n" + + "-include(\"protocol/tProtocol.hrl\").\n"; } /** @@ -414,7 +414,7 @@ void t_erl_generator::generate_erl_struct_reader(ostream& out, indent_up(); out << - indent() << "?M0(Iprot, readStructBegin)," << endl << + indent() << "?R0(Iprot, readStructBegin)," << endl << indent() << "Str = " << uncapitalize(type_name(tstruct)) << "_read_loop(Iprot, "; // if (fields.size() > 0) { // cpiro: sensible default for non-empty structs @@ -424,7 +424,7 @@ void t_erl_generator::generate_erl_struct_reader(ostream& out, // } out << ")," << endl << - indent() << "?M0(Iprot, readStructEnd)," << endl << + indent() << "?R0(Iprot, readStructEnd)," << endl << indent() << "Str." << endl; indent_down(); @@ -434,9 +434,9 @@ void t_erl_generator::generate_erl_struct_reader(ostream& out, indent_up(); // Read beginning field marker - indent(out) << - "{ Fname, Ftype, Fid } = ?M0(Iprot, readFieldBegin)," << endl << - indent() << "Fid, Fname, % suppress unused warnings" << endl; + out << + indent() << "{ _Fname, Ftype, Fid } = ?R0(Iprot, readFieldBegin)," << endl << + indent() << "Fid, % suppress unused warnings" << endl; // Check for field STOP marker and break indent(out) << "if" << endl; @@ -470,7 +470,7 @@ void t_erl_generator::generate_erl_struct_reader(ostream& out, indent_up(); generate_deserialize_field(out, *f_iter, "Val"); - out << indent() << "?M0(Iprot, readFieldEnd)," << endl + out << indent() << "?R0(Iprot, readFieldEnd)," << endl << indent() << uncapitalize(type_name(tstruct)) << "_read_loop(Iprot, " << "Str#" << uncapitalize(type_name(tstruct)) << "{" << (*f_iter)->get_name() @@ -481,8 +481,8 @@ void t_erl_generator::generate_erl_struct_reader(ostream& out, // In the default case we skip the field out << indent() << "true -> " << endl << - indent() << " ?M1(Iprot, skip, Ftype)," << endl << - indent() << " ?M0(Iprot, readFieldEnd)," << endl << + indent() << " ?R1(Iprot, skip, Ftype)," << endl << + indent() << " ?R0(Iprot, readFieldEnd)," << endl << indent() << " " << uncapitalize(type_name(tstruct)) << "_read_loop(Iprot, Str)" << endl; indent_down(); indent(out) << "end." << endl; @@ -519,9 +519,9 @@ void t_erl_generator::generate_erl_struct_writer(ostream& out, // TODO indent(out) << fname << "(Str, Oprot) -> %xy" << endl; indent_up(); - indent(out) << - "Str, % suppress unused warnings" << endl << - indent() << "?M1(Oprot, writeStructBegin, \"" << name << "\")," << endl; + out << + indent() << "Str, % suppress unused warnings" << endl << + indent() << "?R1(Oprot, writeStructBegin, \"" << name << "\")," << endl; string prefix = string("Str#") + uncapitalize(type_name(tstruct)) + "."; @@ -532,7 +532,7 @@ void t_erl_generator::generate_erl_struct_writer(ostream& out, // TODO "if " << prefix << (*f_iter)->get_name() << " /= undefined ->" << endl; indent_up(); indent(out) << - "?M3(Oprot, writeFieldBegin, " << + "?R3(Oprot, writeFieldBegin, " << "\"" << (*f_iter)->get_name() << "\", " << type_to_enum((*f_iter)->get_type()) << ", " << (*f_iter)->get_key() << ")," << endl; @@ -542,7 +542,7 @@ void t_erl_generator::generate_erl_struct_writer(ostream& out, // TODO // Write field closer indent(out) << - "?M0(Oprot, writeFieldEnd);" << endl << + "?R0(Oprot, writeFieldEnd);" << endl << indent() << "true -> ok" << endl; indent_down(); @@ -551,8 +551,8 @@ void t_erl_generator::generate_erl_struct_writer(ostream& out, // TODO // Write the struct map out << - indent() << "?M0(Oprot, writeFieldStop)," << endl << - indent() << "?M0(Oprot, writeStructEnd)," << endl << + indent() << "?R0(Oprot, writeFieldStop)," << endl << + indent() << "?R0(Oprot, writeStructEnd)," << endl << indent() << "ok." << endl; indent_down(); @@ -598,7 +598,7 @@ void t_erl_generator::generate_service(t_service* tservice) { f_service_file_ << "-include(\"" << uncapitalize(tservice->get_name()) << ".hrl\")." << endl << endl; - f_service_file_ << "-export([" << export_lines_.str() << "])."; + f_service_file_ << "-export([" << export_lines_.str() << "])." << endl << endl; f_service_file_ << f_service_.str(); @@ -763,8 +763,9 @@ void t_erl_generator::generate_service_client(t_service* tservice) { // Serialize the request header f_service_ << - indent() << "Oprot = ?ATTR(oprot)," << endl << - indent() << "?M3(Oprot, writeMessageBegin, \"" << (*f_iter)->get_name() << "\", ?tMessageType_CALL, ?ATTR(seqid))," << endl << + indent() << "Oprot = oop:get(This, oprot)," << endl << + indent() << "Seqid = oop:get(This, seqid)," << endl << + indent() << "?R3(Oprot, writeMessageBegin, \"" << (*f_iter)->get_name() << "\", ?tMessageType_CALL, Seqid)," << endl << indent() << "Args = #" << (*f_iter)->get_name() << "_args{"; bool first = true; @@ -779,9 +780,9 @@ void t_erl_generator::generate_service_client(t_service* tservice) { // Write to the stream f_service_ << - indent() << "?M0(Oprot, writeMessageEnd)," << endl << - indent() << "%% side-effect: not gonna happen" << endl << - indent() << "%% ?M0(?M0(Oprot, trans), flush)," << endl << + indent() << "?R0(Oprot, writeMessageEnd)," << endl << + indent() << "Trans = ?R1(Oprot, get, trans)," << endl << + indent() << "?R0(Trans, effectful_flush)," << endl << indent() << "ok." << endl; indent_down(); @@ -806,18 +807,17 @@ void t_erl_generator::generate_service_client(t_service* tservice) { // TODO(cpiro): actually raise an Erlang exception? f_service_ << - indent() << "Iprot = ?ATTR(iprot)," << endl << - indent() << "{ Fname, Mtype, Rseqid } = ?M0(Iprot, readMessageBegin)," << endl << - indent() << "Fname, Rseqid, % suppress unused warnings" << endl << + indent() << "Iprot = oop:get(This, iprot)," << endl << + indent() << "{ _Fname, Mtype, _Rseqid } = ?R0(Iprot, readMessageBegin)," << endl << indent() << "if" << endl << indent() << " Mtype == ?tMessageType_EXCEPTION ->" << endl << indent() << " X = tApplicationException:new()," << endl << - indent() << " ?M1(X, read, Iprot), " << endl << - indent() << " ?M0(Iprot, readMessageEnd), " << endl << + indent() << " tApplicationException:read(X, Iprot), %% cpiro rly treat exceptions different?" << endl << + indent() << " ?R0(Iprot, readMessageEnd), " << endl << indent() << " {error, X};" << endl << indent() << " true ->" << endl << indent() << " Result = " << resultname << "_read(Iprot)," << endl << - indent() << " ?M0(Iprot, readMessageEnd)," << endl << + indent() << " ?R0(Iprot, readMessageEnd)," << endl << indent() << " if % time to figure out retval" << endl; // indent() << " {ok, Success} % result.success casing? Success even for void?" << endl << @@ -845,7 +845,7 @@ void t_erl_generator::generate_service_client(t_service* tservice) { // Careful, only return _result if not a void function if ((*f_iter)->get_returntype()->is_void()) { indent(f_service_) << - indent() << " Result, % suppress unused warnings" << endl << + indent() << " Result," << endl << indent() << " true -> {ok, nil}" << endl << indent() << " end" << endl; } else { @@ -923,8 +923,7 @@ void t_erl_generator::generate_service_server(t_service* tservice) { indent_up(); f_service_ << - indent() << "{ Name, Type, Seqid } = ?M0(Iprot, readMessageBegin)," << endl << - indent() << "Type, % suppress unused warnings" << endl; + indent() << "{ Name, _Type, Seqid } = ?R0(Iprot, readMessageBegin)," << endl; // TODO(mcslee): validate message @@ -940,14 +939,14 @@ void t_erl_generator::generate_service_server(t_service* tservice) { indent(f_service_) << " %% TODO(cpiro): pass to super" << endl; indent(f_service_) << " _ -> % unknown function" << endl << - indent() << " ?M1(Iprot, skip, ?tType_STRUCT)," << endl << - indent() << " ?M0(Iprot, readMessageEnd)," << endl << + indent() << " ?R1(Iprot, skip, ?tType_STRUCT)," << endl << + indent() << " ?R0(Iprot, readMessageEnd)," << endl << indent() << " X = tApplicationException:new(?tApplicationException_UNKNOWN_METHOD, \"Unknown function \" ++ Name)," << endl << - indent() << " ?M3(Oprot, writeMessageBegin, Name, ?tMessageType_EXCEPTION, Seqid)," << endl << - indent() << " ?M1(X, write, Oprot)," << endl << - indent() << " ?M0(Oprot, writeMessageEnd)," << endl << - indent() << " %% side-effect: not gonna happen" << endl << - indent() << " %% ?M0(?M0(Oprot, trans), flush)," << endl << + indent() << " ?R3(Oprot, writeMessageBegin, Name, ?tMessageType_EXCEPTION, Seqid)," << endl << + indent() << " tApplicationException:write(X, Oprot)," << endl << + indent() << " ?R0(Oprot, writeMessageEnd)," << endl << + indent() << " Trans = ?R1(Oprot, get, trans)," << endl << + indent() << " ?R0(Trans, effectful_flush)," << endl << indent() << " {error, X} % what's the retval in this case?" << endl << indent() << "end." << endl; // indent() << "ok. % this one?" << endl << endl; @@ -1000,13 +999,17 @@ void t_erl_generator::generate_process_function(t_service* tservice, "(HandlerModule, Seqid, Iprot, Oprot) ->" << endl; indent_up(); + f_service_ << + indent() << "Seqid, Oprot, % suppress unused warnings" << endl; + string argsname = tfunction->get_name() + "_args"; string resultname = tfunction->get_name() + "_result"; f_service_ << - indent() << "Args = " << argsname << "_read(Iprot)," << endl << - indent() << "Args, Seqid, Oprot, % suppress unused warnings" << endl << - indent() << "?M0(Iprot, readMessageEnd)," << endl; + indent() << "_Args = " << argsname << "_read(Iprot)," << endl << + // indent() << "Args, Seqid, Oprot, % suppress unused warnings" << endl << + // indent() << "Args % suppress unused warnings" << endl << + indent() << "?R0(Iprot, readMessageEnd)," << endl; t_struct* xs = tfunction->get_xceptions(); const std::vector& xceptions = xs->get_members(); @@ -1040,7 +1043,7 @@ void t_erl_generator::generate_process_function(t_service* tservice, } else { f_service_ << ", "; } - f_service_ << "Args#" << tfunction->get_name() << "_args." << (*f_iter)->get_name(); + f_service_ << "_Args#" << tfunction->get_name() << "_args." << (*f_iter)->get_name(); } f_service_ << ")," << endl; @@ -1093,11 +1096,11 @@ void t_erl_generator::generate_process_function(t_service* tservice, indent(f_service_) << "% async" << endl; } else { f_service_ << - indent() << "?M3(Oprot, writeMessageBegin, \"" << tfunction->get_name() << "\", ?tMessageType_REPLY, Seqid)," << endl << + indent() << "?R3(Oprot, writeMessageBegin, \"" << tfunction->get_name() << "\", ?tMessageType_REPLY, Seqid)," << endl << indent() << tfunction->get_name() << "_result_write(Result, Oprot)," << endl << - indent() << "?M0(Oprot, writeMessageEnd)," << endl << - indent() << "%% side-effect: not gonna happen" << endl << - indent() << "%% ?M0(?M0(Oprot, trans), flush)," << endl; + indent() << "?R0(Oprot, writeMessageEnd)," << endl << + indent() << "Trans = ?R1(Oprot, get, trans)," << endl << + indent() << "?R0(Trans, effectful_flush)," << endl; } indent(f_service_) << "Result." << endl << endl; @@ -1135,7 +1138,7 @@ void t_erl_generator::generate_deserialize_field(ostream &out, } else if (type->is_base_type() || type->is_enum()) { indent(out) << // name << " = iprot."; - name << " = ?M0(Iprot, "; + name << " = ?R0(Iprot, "; if (type->is_base_type()) { t_base_type::t_base tbase = ((t_base_type*)type)->get_base(); @@ -1334,7 +1337,7 @@ void t_erl_generator::generate_serialize_field(ostream &out, string name = prefix + tfield->get_name(); indent(out) << - "?M1(Oprot, "; + "?R1(Oprot, "; if (type->is_base_type()) { t_base_type::t_base tbase = ((t_base_type*)type)->get_base(); @@ -1390,7 +1393,7 @@ void t_erl_generator::generate_serialize_struct(ostream &out, string prefix) { indent(out) << tstruct->get_program()->get_name() << "_types:" << uncapitalize(tstruct->get_name()) << "_write(" << prefix << ", Oprot), % generate_serialize_struct" << endl; // indent(out) << - // "?M1(" << prefix << ", write, Oprot), % generate_serialize_struct" << endl; + // "?R1(" << prefix << ", write, Oprot), % generate_serialize_struct" << endl; } void t_erl_generator::generate_serialize_container(ostream &out, @@ -1398,18 +1401,18 @@ void t_erl_generator::generate_serialize_container(ostream &out, string prefix) { if (ttype->is_map()) { indent(out) << - "?M3(Oprot, writeMapBegin, " << + "?R3(Oprot, writeMapBegin, " << type_to_enum(((t_map*)ttype)->get_key_type()) << ", " << type_to_enum(((t_map*)ttype)->get_val_type()) << ", length(" << prefix << ")), % generate_serialize_container" << endl; } else if (ttype->is_set()) { indent(out) << - "?M2(Oprot, writeSetBegin, " << + "?R2(Oprot, writeSetBegin, " << type_to_enum(((t_set*)ttype)->get_elem_type()) << ", length(" << prefix << ")), % generate_serialize_container" << endl; } else if (ttype->is_list()) { indent(out) << - "?M2(Oprot, writeListBegin, " << + "?R2(Oprot, writeListBegin, " << type_to_enum(((t_list*)ttype)->get_elem_type()) << ", length(" << prefix << ")), % generate_serialize_container" << endl; } @@ -1444,13 +1447,13 @@ void t_erl_generator::generate_serialize_container(ostream &out, if (ttype->is_map()) { indent(out) << - "?M0(Oprot, writeMapEnd), % generate_serialize_container" << endl; + "?R0(Oprot, writeMapEnd), % generate_serialize_container" << endl; } else if (ttype->is_set()) { indent(out) << - "?M0(Oprot, writeSetEnd), % generate_serialize_container" << endl; + "?R0(Oprot, writeSetEnd), % generate_serialize_container" << endl; } else if (ttype->is_list()) { indent(out) << - "?M0(Oprot, writeListEnd), % generate_serialize_container" << endl; + "?R0(Oprot, writeListEnd), % generate_serialize_container" << endl; } } diff --git a/lib/erl/Makefile b/lib/erl/Makefile new file mode 100644 index 00000000..072c8fa8 --- /dev/null +++ b/lib/erl/Makefile @@ -0,0 +1,14 @@ +MODULES = lib # release + +all clean: + @for dir in $(MODULES); do \ + (cd $$dir; ${MAKE} $@); \ + if [ "$$?" -ne "0" ]; then ERROR=$$?; echo "Error Code $$ERROR"; exit $$ERROR; fi; \ + done + +docs: + (cd lib; ${MAKE} $@); \ + if [ "$$?" -ne "0" ]; then ERROR=$$?; echo "Error Code $$ERROR"; exit $$ERROR; fi; + +install: + echo NO OP diff --git a/lib/erl/README b/lib/erl/README new file mode 100644 index 00000000..84211bdb --- /dev/null +++ b/lib/erl/README @@ -0,0 +1,68 @@ +Much more information on these topics can be found at www.erlware.org + + +Building the tree +================= + +To build, type make, it should all work from there. + +NOTE** if your system has erlang installed in a directory other than /usr/local/lib/erlang +then you must set the environment variable ERL_RUN_TOP to that directory. For example +if you have erlang installed in /home/jdoe/erlang then you should +export ERL_RUN_TOP=/home/jdoe/erlang + + +Creating a new application +========================== + +A new application can be created by using the appgen utility in otp/tools/utilities. +This utility will create a basic OTP app framework under the otp/lib directory and +an OTP release under the otp/release directory. + +usage: appgen + +Appname is the name of the application that you would like to create. The prefix is +usually the first letter of each word in the appname. This prefix is to avoid name +clashes between applications included in a release (Erlang does not have packages). + +example usage: appgen my_app ma + +which results in + +otp/lib/my_app & otp/release/my_app_rel + +Running a release +================= + +Your release should contain all that you need to run your application. If your application +depends on any applications that are supplied outside of this build tree or OTP itself then +they may be added to the _rel.rel.src file. If the extra applications are present +in this build tree then they will be found by the make process and included in the final +release. + +To run a release there are two options: "local" and installed. The local version can be found +in the otp/release/_rel/local directory which is added by the make process. This +should be used during development to run your release interactively via an Erlang shell. +To run a release in local mode cd into the "local" directory and run _rel.sh. + +The second way to run a release is to install it and run it as a daemon. This is used for +applications in a production setting. To do this you need to first run make & make install +from the _rel directory. This will place a complete production ready versioned +release in the /usr/local/lib/ directory under _rel. To run an installed release +cd to /usr/local/lib/_rel/release/ and run _rel.sh. + +In the case where you want to create a production ready release on one machine and then deploy it +on multiple identical machines you may create a production tar archive. To do this run +make & make tar from the otp/release/_rel/ directory. This will create a tar file conataining +the release name and version number in the file name. This tar can be shipped to its destination and +untarred. Within the untarred directory there is a shell script entitled install.sh. Running this +script will install the release by default in /usr/local/lib/_rel. An optional argument +can be provided that will direct the installation to a different directory. + +Example install.sh /opt/lib + +This will install the release in /opt/lib/_rel + + + + diff --git a/lib/erl/build/beamver b/lib/erl/build/beamver new file mode 100644 index 00000000..fe448b96 --- /dev/null +++ b/lib/erl/build/beamver @@ -0,0 +1,59 @@ +#!/bin/sh + +# erlwareSys: otp/build/beamver,v 1.1 2002/02/14 11:45:20 hal Exp $ + +# usage: beamver +# +# if there's a usable -vsn() attribute, print it and exit with status 0 +# otherwise, print nothing and exit with status 1 + +# From the Erlang shell: +# +# 5> code:which(acca_inets). +# "/home/martin/work/otp/releases//../../acca/ebin/.beam" +# +# 8> beam_lib:version(code:which()). +# {ok,{,['$Id: beamver,v 1.1.1.1 2003/06/13 21:43:21 mlogan Exp $ ']}} + +# TMPFILE looks like this: +# +# io:format("hello ~p~n", +# beam_lib:version("/home/hal/work/otp/acca/ebin/acca_inets.beam")]). + +TMPFILE=/tmp/beamver.$$ + +# exit with failure if we can't read the file +test -f "$1" || exit 1 +BEAMFILE=\"$1\" + +cat > $TMPFILE <<_EOF +io:format("~p~n", + [beam_lib:version($BEAMFILE)]). +_EOF + +# beam_result is {ok,{Module_name, Beam_version} or {error,beam_lib,{Reason}} +beam_result=`erl -noshell \ + -s file eval $TMPFILE \ + -s erlang halt` + +rm -f $TMPFILE + +# sed regexes: +# remove brackets and anything outside them +# remove quotes and anything outside them +# remove apostrophes and anything outside them +# remove leading and trailing spaces + +case $beam_result in +\{ok*) + echo $beam_result | sed -e 's/.*\[\(.*\)].*/\1/' \ + -e 's/.*\"\(.*\)\".*/\1/' \ + -e "s/.*\'\(.*\)\'.*/\1/" \ + -e 's/ *$//' -e 's/^ *//' + exit 0 + ;; +*) + exit 1 + ;; +esac + diff --git a/lib/erl/build/buildtargets.mk b/lib/erl/build/buildtargets.mk new file mode 100644 index 00000000..24d0bf89 --- /dev/null +++ b/lib/erl/build/buildtargets.mk @@ -0,0 +1,14 @@ +EBIN=../ebin +EMULATOR=beam + +ERLC_WFLAGS = -W +ERLC = erlc $(ERLC_WFLAGS) $(ERLC_FLAGS) +ERL = erl -boot start_clean +ESRC = . + +$(EBIN)/%.beam: $(ESRC)/%.erl + $(ERLC) $(ERL_FLAGS) $(ERL_COMPILE_FLAGS) -o$(EBIN) $< + +.erl.beam: + $(ERLC) $(ERL_FLAGS) $(ERL_COMPILE_FLAGS) -o$(dir $@) $< + diff --git a/lib/erl/build/colors.mk b/lib/erl/build/colors.mk new file mode 100644 index 00000000..4d69c41d --- /dev/null +++ b/lib/erl/build/colors.mk @@ -0,0 +1,24 @@ +# Colors to assist visual inspection of make output. + +# Colors +LGRAY=$$'\e[0;37m' +DGRAY=$$'\e[1;30m' +LGREEN=$$'\e[1;32m' +LBLUE=$$'\e[1;34m' +LCYAN=$$'\e[1;36m' +LPURPLE=$$'\e[1;35m' +LRED=$$'\e[1;31m' +NO_COLOR=$$'\e[0m' +DEFAULT=$$'\e[0m' +BLACK=$$'\e[0;30m' +BLUE=$$'\e[0;34m' +GREEN=$$'\e[0;32m' +CYAN=$$'\e[0;36m' +RED=$$'\e[0;31m' +PURPLE=$$'\e[0;35m' +BROWN=$$'\e[0;33m' +YELLOW=$$'\e[1;33m' +WHITE=$$'\e[1;37m' + +BOLD=$$'\e[1;37m' +OFF=$$'\e[0m' diff --git a/lib/erl/build/docs.mk b/lib/erl/build/docs.mk new file mode 100644 index 00000000..b0b7377f --- /dev/null +++ b/lib/erl/build/docs.mk @@ -0,0 +1,12 @@ +EDOC_PATH=../../../tools/utilities + +#single place to include docs from. +docs: + @mkdir -p ../doc + @echo -n $${MY_BLUE:-$(BLUE)}; \ + $(EDOC_PATH)/edoc $(APP_NAME); \ + if [ $$? -eq 0 ]; then \ + echo $${MY_LRED:-$(LRED)}"$$d Doc Failed"; \ + fi; \ + echo -n $(OFF)$(NO_COLOR) + diff --git a/lib/erl/build/mime.types b/lib/erl/build/mime.types new file mode 100644 index 00000000..d6e3c0d0 --- /dev/null +++ b/lib/erl/build/mime.types @@ -0,0 +1,98 @@ + +application/activemessage +application/andrew-inset +application/applefile +application/atomicmail +application/dca-rft +application/dec-dx +application/mac-binhex40 hqx +application/mac-compactpro cpt +application/macwriteii +application/msword doc +application/news-message-id +application/news-transmission +application/octet-stream bin dms lha lzh exe class +application/oda oda +application/pdf pdf +application/postscript ai eps ps +application/powerpoint ppt +application/remote-printing +application/rtf rtf +application/slate +application/wita +application/wordperfect5.1 +application/x-bcpio bcpio +application/x-cdlink vcd +application/x-compress Z +application/x-cpio cpio +application/x-csh csh +application/x-director dcr dir dxr +application/x-dvi dvi +application/x-gtar gtar +application/x-gzip gz +application/x-hdf hdf +application/x-httpd-cgi cgi +application/x-koan skp skd skt skm +application/x-latex latex +application/x-mif mif +application/x-netcdf nc cdf +application/x-sh sh +application/x-shar shar +application/x-stuffit sit +application/x-sv4cpio sv4cpio +application/x-sv4crc sv4crc +application/x-tar tar +application/x-tcl tcl +application/x-tex tex +application/x-texinfo texinfo texi +application/x-troff t tr roff +application/x-troff-man man +application/x-troff-me me +application/x-troff-ms ms +application/x-ustar ustar +application/x-wais-source src +application/zip zip +audio/basic au snd +audio/mpeg mpga mp2 +audio/x-aiff aif aiff aifc +audio/x-pn-realaudio ram +audio/x-pn-realaudio-plugin rpm +audio/x-realaudio ra +audio/x-wav wav +chemical/x-pdb pdb xyz +image/gif gif +image/ief ief +image/jpeg jpeg jpg jpe +image/png png +image/tiff tiff tif +image/x-cmu-raster ras +image/x-portable-anymap pnm +image/x-portable-bitmap pbm +image/x-portable-graymap pgm +image/x-portable-pixmap ppm +image/x-rgb rgb +image/x-xbitmap xbm +image/x-xpixmap xpm +image/x-xwindowdump xwd +message/external-body +message/news +message/partial +message/rfc822 +multipart/alternative +multipart/appledouble +multipart/digest +multipart/mixed +multipart/parallel +text/html html htm +text/x-server-parsed-html shtml +text/plain txt +text/richtext rtx +text/tab-separated-values tsv +text/x-setext etx +text/x-sgml sgml sgm +video/mpeg mpeg mpg mpe +video/quicktime qt mov +video/x-msvideo avi +video/x-sgi-movie movie +x-conference/x-cooltalk ice +x-world/x-vrml wrl vrml diff --git a/lib/erl/build/otp.mk b/lib/erl/build/otp.mk new file mode 100644 index 00000000..4e93ea8c --- /dev/null +++ b/lib/erl/build/otp.mk @@ -0,0 +1,146 @@ +# +----------------------------------------------------------------------+ +# $Id: otp.mk,v 1.4 2004/07/01 14:57:10 tfee Exp $ +# +----------------------------------------------------------------------+ + +# otp.mk +# - to be included in all OTP Makefiles +# installed to /usr/local/include/erlang/otp.mk + +# gmake looks in /usr/local/include - that's hard-coded +# users of this file will use +# include erlang/top.mk + +# most interface files will be installed to $ERL_RUN_TOP/app-vsn/include/*.hrl + +# group owner for library/include directories +ERLANGDEV_GROUP=erlangdev + +# ERL_TOP is root of Erlang source tree +# ERL_RUN_TOP is root of Erlang target tree (some Ericsson Makefiles use $ROOT) +# ERLANG_OTP is target root for Erlang code +# - see sasl/systools reference manual page; grep "TEST" + +# OS_TYPE is FreeBSD, NetBSD, OpenBSD, Linux, SCO_SV, SunOS. +OS_TYPE=${shell uname} + +# MHOST is the host where this Makefile runs. +MHOST=${shell hostname -s} +ERL_COMPILE_FLAGS+=-W0 + +# The location of the erlang runtime system. +ifndef ERL_RUN_TOP +ERL_RUN_TOP=/usr/local/lib/erlang +endif + + +# Edit to reflect local environment. +# ifeq (${OS_TYPE},Linux) +# ERL_RUN_TOP=/usr/local/lib/erlang +# Note* ERL_RUN_TOP can be determined by starting an +# erlang shell and typing code:root_dir(). +# ERL_TOP=a symbolic link to the actual source top, which changes from version to version +# Note* ERL_TOP is the directory where the erlang +# source files reside. Make sure to run ./configure there. +# TARGET=i686-pc-linux-gnu +# Note* Target can be found in $ERL_TOP/erts +# endif + +# See above for directions. +ifeq (${OS_TYPE},Linux) +ERL_TOP=/opt/OTP_SRC +TARGET=i686-pc-linux-gnu +endif + +ERLANG_OTP=/usr/local/erlang/otp +VAR_OTP=/var/otp + + +# Aliases for common binaries +# Note - CFLAGS is modified in erlang.conf + + +################################ +# SunOS +################################ +ifeq (${OS_TYPE},SunOS) + + CC=gcc + CXX=g++ + AR=/usr/ccs/bin/ar + ARFLAGS=-rv + CXXFLAGS+=${CFLAGS} -I/usr/include/g++ + LD=/usr/ccs/bin/ld + RANLIB=/usr/ccs/bin/ranlib + +CFLAGS+=-Wall -pedantic -ansi -O +CORE=*.core +endif + + +################################ +# FreeBSD +################################ +ifeq (${OS_TYPE},FreeBSD) + + ifdef LINUXBIN + COMPAT_LINUX=/compat/linux + CC=${COMPAT_LINUX}/usr/bin/gcc + CXX=${COMPAT_LINUX}/usr/bin/g++ + AR=${COMPAT_LINUX}/usr/bin/ar + ARFLAGS=-rv + CXXFLAGS+=-fhandle-exceptions ${CFLAGS} -I${COMPAT_LINUX}/usr/include/g++ + LD=${COMPAT_LINUX}/usr/bin/ld + RANLIB=${COMPAT_LINUX}/usr/bin/ranlib + BRANDELF=brandelf -t Linux + else + CC=gcc + CXX=g++ + AR=/usr/bin/ar + ARFLAGS=-rv + CXXFLAGS+=-fhandle-exceptions ${CFLAGS} -I/usr/include/g++ + LD=/usr/bin/ld + RANLIB=/usr/bin/ranlib + BRANDELF=@true + + ifdef USES_PTHREADS + CFLAGS+=-D_THREAD_SAFE + LDFLAGS+=-lc_r + + # -pthread flag for 3.0+ + ifneq (${shell uname -r | cut -d. -f1},2) + CFLAGS+=-pthread + endif + endif + endif + +CFLAGS+=-Wall -pedantic -ansi -O -DFREEBSD +CORE=*.core +endif + +################################ +# OpenBSD +################################ +ifeq (${OS_TYPE},OpenBSD) + + CC=gcc + CXX=g++ + AR=/usr/bin/ar + ARFLAGS=-rv + CXXFLAGS+=${CFLAGS} -I/usr/include/g++ + LD=/usr/bin/ld + RANLIB=/usr/bin/ranlib + + ifdef USES_PTHREADS + CFLAGS+=-D_THREAD_SAFE + LDFLAGS+=-lc_r + + # -pthread flag for 3.0+ + ifneq (${shell uname -r | cut -d. -f1},2) + CFLAGS+=-pthread + endif + endif + +CFLAGS+=-Wall -pedantic -ansi -O -DOPENBSD +CORE=*.core +endif + diff --git a/lib/erl/build/otp_subdir.mk b/lib/erl/build/otp_subdir.mk new file mode 100644 index 00000000..73339693 --- /dev/null +++ b/lib/erl/build/otp_subdir.mk @@ -0,0 +1,85 @@ +# Comment by tfee 2004-07-01 +# ========================== +# This file is a mod of the stock OTP one. +# The change allows make to stop when a compile error occurs. +# This file needs to go into two places: +# /usr/local/include/erlang +# /opt/OTP_SRC/make +# +# where OTP_SRC is a symbolic link to a peer directory containing +# the otp source, e.g. otp_src_R9C-2. +# +# After installing OTP, running sudo make install in otp/build +# will push this file out to the two places listed above. +# +# The mod involves setting the shell variable $short_circuit, which we +# introduce - ie it is not in the stock file. This variable is tested +# to affect execution flow and is also returned to affect the flow in +# the calling script (this one). The latter step is necessary because +# of the recursion involved. +# ===================================================================== + + +# ``The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved via the world wide web at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# The Initial Developer of the Original Code is Ericsson Utvecklings AB. +# Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings +# AB. All Rights Reserved.'' +# +# $Id: otp_subdir.mk,v 1.5 2004/07/12 15:12:23 jeinhorn Exp $ +# +# +# Make include file for otp + +.PHONY: debug opt release docs release_docs tests release_tests \ + clean depend + +# +# Targets that don't affect documentation directories +# +debug opt release docs release_docs tests release_tests clean depend: prepare + @set -e ; \ + app_pwd=`pwd` ; \ + if test -f vsn.mk; then \ + echo "=== Entering application" `basename $$app_pwd` ; \ + fi ; \ + case "$(MAKE)" in *clearmake*) tflag="-T";; *) tflag="";; esac; \ + short_circuit=0 ; \ + for d in $(SUB_DIRECTORIES); do \ + if [[ $$short_circuit = 0 ]]; then \ + if test -f $$d/SKIP ; then \ + echo "=== Skipping subdir $$d, reason:" ; \ + cat $$d/SKIP ; \ + echo "===" ; \ + else \ + if test ! -d $$d ; then \ + echo "=== Skipping subdir $$d, it is missing" ; \ + else \ + xflag="" ; \ + if test -f $$d/ignore_config_record.inf; then \ + xflag=$$tflag ; \ + fi ; \ + (cd $$d && $(MAKE) $$xflag $@) ; \ + if [[ $$? != 0 ]]; then \ + short_circuit=1 ; \ + fi ; \ + fi ; \ + fi ; \ + fi ; \ + done ; \ + if test -f vsn.mk; then \ + echo "=== Leaving application" `basename $$app_pwd` ; \ + fi ; \ + exit $$short_circuit + +prepare: + echo diff --git a/lib/erl/build/raw_test.mk b/lib/erl/build/raw_test.mk new file mode 100644 index 00000000..dbacf18f --- /dev/null +++ b/lib/erl/build/raw_test.mk @@ -0,0 +1,29 @@ +# for testing erlang files directly. The set up for a +# this type of test would be +# files to test reside in lib//src and the test files which are +# just plain erlang code reside in lib//test +# +# This color codes emitted while the tests run assume that you are using +# a white-on-black display schema. If not, e.g. if you use a white +# background, you will not be able to read the "WHITE" text. +# You can override this by supplying your own "white" color, +# which may in fact be black! You do this by defining an environment +# variable named "MY_WHITE" and setting it to $'\e[0;30m' (which is +# simply bash's way of specifying "Escape [ 0 ; 3 0 m"). +# Similarly, you can set your versions of the standard colors +# found in colors.mk. + +test: + @TEST_MODULES=`ls *_test.erl`; \ + trap "echo $(OFF)$(NO_COLOR); exit 1;" 1 2 3 6; \ + for d in $$TEST_MODULES; do \ + echo $${MY_GREEN:-$(GREEN)}"Testing File $$d" $${MY_WHITE:-$(WHITE)}; \ + echo -n $${MY_BLUE:-$(BLUE)}; \ + erl -name $(APP_NAME) $(TEST_LIBS) \ + -s `basename $$d .erl` all -s init stop -noshell; \ + if [ $$? -ne 0 ]; then \ + echo $${MY_LRED:-$(LRED)}"$$d Test Failed"; \ + fi; \ + echo -n $(OFF)$(NO_COLOR); \ + done + diff --git a/lib/erl/lib/Makefile b/lib/erl/lib/Makefile new file mode 100644 index 00000000..4e3bfda6 --- /dev/null +++ b/lib/erl/lib/Makefile @@ -0,0 +1,10 @@ +include ../build/colors.mk + +MODULES=$(shell ls . | grep "[^(Makefile)]") + +all clean docs: + @for dir in $(MODULES); do \ + (cd $$dir; if [ -e "SKIP" ]; then echo $${MY_LRED:-$(LRED)}"skipping \"make $@\" for $$dir"; else ${MAKE} $@; fi); \ + if [ "$$?" -ne "0" ]; then ERROR=$$?; echo "Error Code $$ERROR"; exit $$ERROR; fi; \ + echo -n $(OFF)$(NO_COLOR); \ + done diff --git a/lib/erl/lib/thrift/COPYING b/lib/erl/lib/thrift/COPYING new file mode 100644 index 00000000..039f21e3 --- /dev/null +++ b/lib/erl/lib/thrift/COPYING @@ -0,0 +1,24 @@ +Thrift Software License +Copyright (c) 2006- Facebook, Inc. + +Permission is hereby granted, free of charge, to any person or organization +obtaining a copy of the software and accompanying documentation covered by +this license (the "Software") to use, reproduce, display, distribute, +execute, and transmit the Software, and to prepare derivative works of the +Software, and to permit third-parties to whom the Software is furnished to +do so, all subject to the following: + +The copyright notices in the Software and this entire statement, including +the above license grant, this restriction and the following disclaimer, +must be included in all copies of the Software, in whole or in part, and +all derivative works of the Software, unless such copies or derivative +works are solely in the form of machine-executable object code generated by +a source language processor. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE, TITLE AND NON-INFRINGEMENT. IN NO EVENT +SHALL THE COPYRIGHT HOLDERS OR ANYONE DISTRIBUTING THE SOFTWARE BE LIABLE +FOR ANY DAMAGES OR OTHER LIABILITY, WHETHER IN CONTRACT, TORT OR OTHERWISE, +ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +DEALINGS IN THE SOFTWARE. diff --git a/lib/erl/lib/thrift/HEADER b/lib/erl/lib/thrift/HEADER new file mode 100644 index 00000000..abd3efbc --- /dev/null +++ b/lib/erl/lib/thrift/HEADER @@ -0,0 +1,6 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + diff --git a/lib/erl/lib/thrift/LICENSE b/lib/erl/lib/thrift/LICENSE new file mode 100644 index 00000000..039f21e3 --- /dev/null +++ b/lib/erl/lib/thrift/LICENSE @@ -0,0 +1,24 @@ +Thrift Software License +Copyright (c) 2006- Facebook, Inc. + +Permission is hereby granted, free of charge, to any person or organization +obtaining a copy of the software and accompanying documentation covered by +this license (the "Software") to use, reproduce, display, distribute, +execute, and transmit the Software, and to prepare derivative works of the +Software, and to permit third-parties to whom the Software is furnished to +do so, all subject to the following: + +The copyright notices in the Software and this entire statement, including +the above license grant, this restriction and the following disclaimer, +must be included in all copies of the Software, in whole or in part, and +all derivative works of the Software, unless such copies or derivative +works are solely in the form of machine-executable object code generated by +a source language processor. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE, TITLE AND NON-INFRINGEMENT. IN NO EVENT +SHALL THE COPYRIGHT HOLDERS OR ANYONE DISTRIBUTING THE SOFTWARE BE LIABLE +FOR ANY DAMAGES OR OTHER LIABILITY, WHETHER IN CONTRACT, TORT OR OTHERWISE, +ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +DEALINGS IN THE SOFTWARE. diff --git a/lib/erl/lib/thrift/Makefile b/lib/erl/lib/thrift/Makefile new file mode 100644 index 00000000..0f2c8a82 --- /dev/null +++ b/lib/erl/lib/thrift/Makefile @@ -0,0 +1,7 @@ +MODULES = \ + src + +all clean docs: + for dir in $(MODULES); do \ + (cd $$dir; ${MAKE} $@); \ + done diff --git a/lib/erl/lib/thrift/README b/lib/erl/lib/thrift/README new file mode 100644 index 00000000..3d2fd6db --- /dev/null +++ b/lib/erl/lib/thrift/README @@ -0,0 +1,39 @@ +YMMV +email cpiro@facebook.com +-- + +TO START A SERVER: + +$ cd lib/erl/lib/thrift/ +$ cd tutorial +$ thrift -cpp -java -py -php -rb -perl -erl -xsd -r tutorial.thrift +$ cd .. +$ make +$ ./server.sh +> Pid = server:start(). + ** GAZE IN AMAZEMENT ** +> server:stop(Pid). + +NOTES: + +get/set never means process dictionary + +tExecptions and t*Factorys are straight "new" -- e.g. TF = tTransportFactory:new() +everything else is start_new (i.e. gen_server:start_link) -- this spawns a process and returns a pid + +notable change from the Ruby: +in t*Server:new, the parameters now include a handler, i.e. the generated module name. For example if your interface is called calculator, then to spawn a TSimpleServer try: oop:start_new(tSimpleServer, [calculator, calculatorHandler, Transport, TF]) + +tErlProcessor is a shim around the generated code (which is not actually a gen_server). Of course tErlProcessor isn't a gen_server either ... thrift_oop_server is a shim to make our "Thrift objects" gen_servers. Maybe we should remove some layers? + +Use tErlServer and tErlAcceptor. tSimpleServer and tServerSocket are incompatible by design ... the call trace is spastic across the process tree. tErlServer and tErlAcceptor follow the same model as iserve: + * the top level code spawns a tErlServer, which listens on a socket + * a tErlAcceptor is spawned and calls accept() on the listening socket + * when accept() finishes, the tErlAcceptor + * tells the tErlServer to spawn a new acceptor + * handles the requests by spawning a processor, a transport, and a protocol + * (the tricky part) when the socket closes, the protocol exits, so: + * the transport exits because it's the one caller of the protocol + * likewise, the processor exits because it's the caller of the transport + * the tErlAcceptor traps the protocol's exit and exits with an acceptor_done + * the tErlServer sees that the acceptor exited and does nothing since there is already another acceptor accept()ing on the listen socket diff --git a/lib/erl/lib/thrift/TODO b/lib/erl/lib/thrift/TODO new file mode 100644 index 00000000..e2a870d7 --- /dev/null +++ b/lib/erl/lib/thrift/TODO @@ -0,0 +1,10 @@ +tutorial client + +find TODO(cpiro)s +make all methods effectful, remove the special casing (optionally, implement monads for Erlang) + +inheritance + +test suites + +undisgustify codegen diff --git a/lib/erl/lib/thrift/include/oop.hrl b/lib/erl/lib/thrift/include/oop.hrl new file mode 100644 index 00000000..b48e1cee --- /dev/null +++ b/lib/erl/lib/thrift/include/oop.hrl @@ -0,0 +1,26 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-define(CLASS(Obj), element(1, Obj)). + +-define(DEFINE_ATTR(Attr), attr(This, get, Attr, _Value) -> This#?MODULE.Attr; + attr(This, set, Attr, Value) -> This#?MODULE{Attr=Value} +). + +%%% static: use only if you're sure This is class ?MODULE and not a super/subclass +-define(ATTR(Attr), This#?MODULE.Attr). + +%%% convenience for implementing inspect/1 +%%% e.g. -> "foo=5" +-define(FORMAT_ATTR(Attr), + io_lib:write_atom(Attr) ++ "=" ++ io_lib:print(?ATTR(Attr)) +). + + +-define(ATTR_DUMMY, + attr(dummy, dummy, dummy, dummy) -> + throw(dummy_attr_used) +). diff --git a/lib/erl/lib/thrift/include/protocol/tBinaryProtocol.hrl b/lib/erl/lib/thrift/include/protocol/tBinaryProtocol.hrl new file mode 100644 index 00000000..c9768398 --- /dev/null +++ b/lib/erl/lib/thrift/include/protocol/tBinaryProtocol.hrl @@ -0,0 +1,10 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-define(VERSION_MASK, 16#FFFF0000). +-define(VERSION_1, 16#80010000). + +-record(tBinaryProtocol, {super}). diff --git a/lib/erl/lib/thrift/include/protocol/tBinaryProtocolFactory.hrl b/lib/erl/lib/thrift/include/protocol/tBinaryProtocolFactory.hrl new file mode 100644 index 00000000..266932c7 --- /dev/null +++ b/lib/erl/lib/thrift/include/protocol/tBinaryProtocolFactory.hrl @@ -0,0 +1,7 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-record(tBinaryProtocolFactory, {super}). diff --git a/lib/erl/lib/thrift/include/protocol/tProtocol.hrl b/lib/erl/lib/thrift/include/protocol/tProtocol.hrl new file mode 100644 index 00000000..3e42d67a --- /dev/null +++ b/lib/erl/lib/thrift/include/protocol/tProtocol.hrl @@ -0,0 +1,7 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-record(tProtocol, {trans}). diff --git a/lib/erl/lib/thrift/include/protocol/tProtocolException.hrl b/lib/erl/lib/thrift/include/protocol/tProtocolException.hrl new file mode 100644 index 00000000..2de72d71 --- /dev/null +++ b/lib/erl/lib/thrift/include/protocol/tProtocolException.hrl @@ -0,0 +1,15 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-define(tProtocolException_UNKNOWN, 0). +-define(tProtocolException_INVALID_DATA, 1). +-define(tProtocolException_NEGATIVE_SIZE, 2). +-define(tProtocolException_SIZE_LIMIT, 3). +-define(tProtocolException_BAD_VERSION, 4). + +-record(tProtocolException, {super, type}). + + diff --git a/lib/erl/lib/thrift/include/protocol/tProtocolFactory.hrl b/lib/erl/lib/thrift/include/protocol/tProtocolFactory.hrl new file mode 100644 index 00000000..56c7fee4 --- /dev/null +++ b/lib/erl/lib/thrift/include/protocol/tProtocolFactory.hrl @@ -0,0 +1,7 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-record(tProtocolFactory, {}). diff --git a/lib/erl/lib/thrift/include/server/tErlServer.hrl b/lib/erl/lib/thrift/include/server/tErlServer.hrl new file mode 100644 index 00000000..0a669932 --- /dev/null +++ b/lib/erl/lib/thrift/include/server/tErlServer.hrl @@ -0,0 +1,7 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-record(tErlServer, {super, acceptor, listenSocket, port}). diff --git a/lib/erl/lib/thrift/include/server/tServer.hrl b/lib/erl/lib/thrift/include/server/tServer.hrl new file mode 100644 index 00000000..502a137f --- /dev/null +++ b/lib/erl/lib/thrift/include/server/tServer.hrl @@ -0,0 +1,7 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-record(tServer, {handler, processor, serverTransport, transportFactory, protocolFactory}). diff --git a/lib/erl/lib/thrift/include/server/tSimpleServer.hrl b/lib/erl/lib/thrift/include/server/tSimpleServer.hrl new file mode 100644 index 00000000..f115d0bd --- /dev/null +++ b/lib/erl/lib/thrift/include/server/tSimpleServer.hrl @@ -0,0 +1,7 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-record(tSimpleServer, {super}). diff --git a/lib/erl/src-loose/tApplicationException.hrl b/lib/erl/lib/thrift/include/tApplicationException.hrl similarity index 57% rename from lib/erl/src-loose/tApplicationException.hrl rename to lib/erl/lib/thrift/include/tApplicationException.hrl index ab1f4012..e2f15384 100644 --- a/lib/erl/src-loose/tApplicationException.hrl +++ b/lib/erl/lib/thrift/include/tApplicationException.hrl @@ -1,3 +1,9 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + % TApplicationException -define(tApplicationException_UNKNOWN, 0). -define(tApplicationException_UNKNOWN_METHOD, 1). @@ -6,4 +12,4 @@ -define(tApplicationException_BAD_SEQUENCE_ID, 4). -define(tApplicationException_MISSING_RESULT, 5). --record(tApplicationException, {message, type=?tApplicationException_UNKNOWN}). +-record(tApplicationException, {super, type}). diff --git a/lib/erl/lib/thrift/include/tErlProcessor.hrl b/lib/erl/lib/thrift/include/tErlProcessor.hrl new file mode 100644 index 00000000..78b91f15 --- /dev/null +++ b/lib/erl/lib/thrift/include/tErlProcessor.hrl @@ -0,0 +1,7 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-record(tErlProcessor, {super, generatedProcessor, handler}). diff --git a/lib/erl/lib/thrift/include/tException.hrl b/lib/erl/lib/thrift/include/tException.hrl new file mode 100644 index 00000000..808a4749 --- /dev/null +++ b/lib/erl/lib/thrift/include/tException.hrl @@ -0,0 +1,7 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-record(tException, {message}). diff --git a/lib/erl/lib/thrift/include/tProcessor.hrl b/lib/erl/lib/thrift/include/tProcessor.hrl new file mode 100644 index 00000000..3d138cde --- /dev/null +++ b/lib/erl/lib/thrift/include/tProcessor.hrl @@ -0,0 +1,8 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-record(tProcessor, {}). + diff --git a/lib/erl/lib/thrift/include/thrift.hrl b/lib/erl/lib/thrift/include/thrift.hrl new file mode 100644 index 00000000..b47fd390 --- /dev/null +++ b/lib/erl/lib/thrift/include/thrift.hrl @@ -0,0 +1,100 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +% local (same process) +-define(L0(Method), oop:call(This, Method, [])). +-define(L1(Method, Arg1), oop:call(This, Method, [Arg1])). +-define(L2(Method, Arg1, Arg2), oop:call(This, Method, [Arg1, Arg2])). +-define(L3(Method, Arg1, Arg2, Arg3), oop:call(This, Method, [Arg1, Arg2, Arg3])). +-define(L4(Method, Arg1, Arg2, Arg3, Arg4), oop:call(This, Method, [Arg1, Arg2, Arg3, Arg4])). +-define(L5(Method, Arg1, Arg2, Arg3, Arg4, Arg5), oop:call(This, Method, [Arg1, Arg2, Arg3, Arg4, Arg5])). +-define(L6(Method, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6), oop:call(This, Method, [Arg1, Arg2, Arg3, Arg4, Arg5, Arg6])). + +% local (same process), but not This (e.g. t*Factory) +-define(F0(Obj, Method), oop:call(Obj, Method, [])). +-define(F1(Obj, Method, Arg1), oop:call(Obj, Method, [Arg1])). +-define(F2(Obj, Method, Arg1, Arg2), oop:call(Obj, Method, [Arg1, Arg2])). +-define(F3(Obj, Method, Arg1, Arg2, Arg3), oop:call(Obj, Method, [Arg1, Arg2, Arg3])). +-define(F4(Obj, Method, Arg1, Arg2, Arg3, Arg4), oop:call(Obj, Method, [Arg1, Arg2, Arg3, Arg4])). +-define(F5(Obj, Method, Arg1, Arg2, Arg3, Arg4, Arg5), oop:call(Obj, Method, [Arg1, Arg2, Arg3, Arg4, Arg5])). +-define(F6(Obj, Method, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6), oop:call(Obj, Method, [Arg1, Arg2, Arg3, Arg4, Arg5, Arg6])). + +% remote (different process) +-define(RT0(ServerRef, Method, Timeout), gen_server:call(ServerRef, {Method, []}, Timeout)). +-define(RT1(ServerRef, Method, Timeout, Arg1), gen_server:call(ServerRef, {Method, [Arg1]}, Timeout)). +-define(RT2(ServerRef, Method, Timeout, Arg1, Arg2), gen_server:call(ServerRef, {Method, [Arg1, Arg2]}, Timeout)). +-define(RT3(ServerRef, Method, Timeout, Arg1, Arg2, Arg3), gen_server:call(ServerRef, {Method, [Arg1, Arg2, Arg3]}, Timeout)). +-define(RT4(ServerRef, Method, Timeout, Arg1, Arg2, Arg3, Arg4), gen_server:call(ServerRef, {Method, [Arg1, Arg2, Arg3, Arg4]}, Timeout)). +-define(RT5(ServerRef, Method, Timeout, Arg1, Arg2, Arg3, Arg4, Arg5), gen_server:call(ServerRef, {Method, [Arg1, Arg2, Arg3, Arg4, Arg5]}, Timeout)). +-define(RT6(ServerRef, Method, Timeout, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6), gen_server:call(ServerRef, {Method, [Arg1, Arg2, Arg3, Arg4, Arg5, Arg6]}, Timeout)). + +% remote (different process), default timeout +-define(DEFAULT_TIMEOUT, 5000). +-define(R0(ServerRef, Method), ?RT0(ServerRef, Method, ?DEFAULT_TIMEOUT)). +-define(R1(ServerRef, Method, Arg1), ?RT1(ServerRef, Method, ?DEFAULT_TIMEOUT, Arg1)). +-define(R2(ServerRef, Method, Arg1, Arg2), ?RT2(ServerRef, Method, ?DEFAULT_TIMEOUT, Arg1, Arg2)). +-define(R3(ServerRef, Method, Arg1, Arg2, Arg3), ?RT3(ServerRef, Method, ?DEFAULT_TIMEOUT, Arg1, Arg2, Arg3)). +-define(R4(ServerRef, Method, Arg1, Arg2, Arg3, Arg4), ?RT4(ServerRef, Method, ?DEFAULT_TIMEOUT, Arg1, Arg2, Arg3, Arg4)). +-define(R5(ServerRef, Method, Arg1, Arg2, Arg3, Arg4, Arg5), ?RT5(ServerRef, Method, ?DEFAULT_TIMEOUT, Arg1, Arg2, Arg3, Arg4, Arg5)). +-define(R6(ServerRef, Method, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6), ?RT6(ServerRef, Method, ?DEFAULT_TIMEOUT, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6)). + +% remote (different process), cast +-define(C0(ServerRef, Method), gen_server:cast(ServerRef, {Method, []})). +-define(C1(ServerRef, Method, Arg1), gen_server:cast(ServerRef, {Method, [Arg1]})). +-define(C2(ServerRef, Method, Arg1, Arg2), gen_server:cast(ServerRef, {Method, [Arg1, Arg2]})). +-define(C3(ServerRef, Method, Arg1, Arg2, Arg3), gen_server:cast(ServerRef, {Method, [Arg1, Arg2, Arg3]})). +-define(C4(ServerRef, Method, Arg1, Arg2, Arg3, Arg4), gen_server:cast(ServerRef, {Method, [Arg1, Arg2, Arg3, Arg4]})). +-define(C5(ServerRef, Method, Arg1, Arg2, Arg3, Arg4, Arg5), gen_server:cast(ServerRef, {Method, [Arg1, Arg2, Arg3, Arg4, Arg5]})). +-define(C6(ServerRef, Method, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6), gen_server:cast(ServerRef, {Method, [Arg1, Arg2, Arg3, Arg4, Arg5, Arg6]})). + +% spawn new server +%% -define(NEW(Class, Args), %% +%% gen_server:start_link(thrift_oop_server, {Class, Args}, [])). %% +%% moved to oop:start_new/2 + +% old +%% -define(M0(Obj, Method), oop:call(Obj, Method, [])). %% +%% -define(M1(Obj, Method, Arg1), oop:call(Obj, Method, [Arg1])). %% +%% -define(M2(Obj, Method, Arg1, Arg2), oop:call(Obj, Method, [Arg1, Arg2])). %% +%% -define(M3(Obj, Method, Arg1, Arg2, Arg3), oop:call(Obj, Method, [Arg1, Arg2, Arg3])). %% +%% -define(M4(Obj, Method, Arg1, Arg2, Arg3, Arg4), oop:call(Obj, Method, [Arg1, Arg2, Arg3, Arg4])). %% +%% -define(M5(Obj, Method, Arg1, Arg2, Arg3, Arg4, Arg5), oop:call(Obj, Method, [Arg1, Arg2, Arg3, Arg4, Arg5])). %% +%% -define(M6(Obj, Method, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6), oop:call(Obj, Method, [Arg1, Arg2, Arg3, Arg4, Arg5, Arg6])). %% + +%%% implicit call: old + +%% -define(M0(Obj, Method), ((?CLASS(Obj)):Method(Obj))). %% +%% -define(M1(Obj, Method, Arg1), ((?CLASS(Obj)):Method(Obj, Arg1))). %% +%% -define(M2(Obj, Method, Arg1, Arg2), ((?CLASS(Obj)):Method(Obj, Arg1, Arg2))). %% +%% -define(M3(Obj, Method, Arg1, Arg2, Arg3), ((?CLASS(Obj)):Method(Obj, Arg1, Arg2, Arg3))). %% +%% -define(M4(Obj, Method, Arg1, Arg2, Arg3, Arg4), ((?CLASS(Obj)):Method(Obj, Arg1, Arg2, Arg3, Arg4))). %% +%% -define(M5(Obj, Method, Arg1, Arg2, Arg3, Arg4, Arg5), ((?CLASS(Obj)):Method(Obj, Arg1, Arg2, Arg3, Arg4, Arg5))). %% +%% -define(M6(Obj, Method, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6), ((?CLASS(Obj)):Method(Obj, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6))). %% + +%% TType +-define(tType_STOP, 0). +-define(tType_VOID, 1). +-define(tType_BOOL, 2). +-define(tType_BYTE, 3). +-define(tType_DOUBLE, 4). +-define(tType_I16, 6). +-define(tType_I32, 8). +-define(tType_I64, 10). +-define(tType_STRING, 11). +-define(tType_STRUCT, 12). +-define(tType_MAP, 13). +-define(tType_SET, 14). +-define(tType_LIST, 15). + +% tmessagetype +-define(tMessageType_CALL, 1). +-define(tMessageType_REPLY, 2). +-define(tMessageType_EXCEPTION, 3). + +% TProcessor +% ? + +% -include("tApplicationException.hrl"). diff --git a/lib/erl/lib/thrift/include/transport/tBufferedTransport.hrl b/lib/erl/lib/thrift/include/transport/tBufferedTransport.hrl new file mode 100644 index 00000000..05c738e3 --- /dev/null +++ b/lib/erl/lib/thrift/include/transport/tBufferedTransport.hrl @@ -0,0 +1,7 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-record(tBufferedTransport, {super, transport, wbuf}). diff --git a/lib/erl/lib/thrift/include/transport/tBufferedTransportFactory.hrl b/lib/erl/lib/thrift/include/transport/tBufferedTransportFactory.hrl new file mode 100644 index 00000000..3a4cdc5e --- /dev/null +++ b/lib/erl/lib/thrift/include/transport/tBufferedTransportFactory.hrl @@ -0,0 +1,7 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-record(tBufferedTransportFactory, {super}). diff --git a/lib/erl/lib/thrift/include/transport/tErlAcceptor.hrl b/lib/erl/lib/thrift/include/transport/tErlAcceptor.hrl new file mode 100644 index 00000000..333feb5d --- /dev/null +++ b/lib/erl/lib/thrift/include/transport/tErlAcceptor.hrl @@ -0,0 +1,7 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-record(tErlAcceptor, {super, serverPid, transportFactory, protocolFactory}). diff --git a/lib/erl/lib/thrift/include/transport/tServerSocket.hrl b/lib/erl/lib/thrift/include/transport/tServerSocket.hrl new file mode 100644 index 00000000..a2c25acb --- /dev/null +++ b/lib/erl/lib/thrift/include/transport/tServerSocket.hrl @@ -0,0 +1,7 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-record(tServerSocket, {super, port, handle}). diff --git a/lib/erl/lib/thrift/include/transport/tServerTransport.hrl b/lib/erl/lib/thrift/include/transport/tServerTransport.hrl new file mode 100644 index 00000000..207bbf63 --- /dev/null +++ b/lib/erl/lib/thrift/include/transport/tServerTransport.hrl @@ -0,0 +1,7 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-record(tServerTransport, {}). diff --git a/lib/erl/lib/thrift/include/transport/tSocket.hrl b/lib/erl/lib/thrift/include/transport/tSocket.hrl new file mode 100644 index 00000000..0317d5aa --- /dev/null +++ b/lib/erl/lib/thrift/include/transport/tSocket.hrl @@ -0,0 +1,7 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-record(tSocket, {super, host, port, handle}). diff --git a/lib/erl/lib/thrift/include/transport/tTransport.hrl b/lib/erl/lib/thrift/include/transport/tTransport.hrl new file mode 100644 index 00000000..ca89413d --- /dev/null +++ b/lib/erl/lib/thrift/include/transport/tTransport.hrl @@ -0,0 +1,7 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-record(tTransport, {}). diff --git a/lib/erl/lib/thrift/include/transport/tTransportException.hrl b/lib/erl/lib/thrift/include/transport/tTransportException.hrl new file mode 100644 index 00000000..1a60aad1 --- /dev/null +++ b/lib/erl/lib/thrift/include/transport/tTransportException.hrl @@ -0,0 +1,13 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-define(tTransportException_UNKNOWN, 0). +-define(tTransportException_NOT_OPEN, 1). +-define(tTransportException_ALREADY_OPEN, 2). +-define(tTransportException_TIMED_OUT, 3). +-define(tTransportException_END_OF_FILE, 4). + +-record(tTransportException, {super, type}). diff --git a/lib/erl/lib/thrift/include/transport/tTransportFactory.hrl b/lib/erl/lib/thrift/include/transport/tTransportFactory.hrl new file mode 100644 index 00000000..d4881408 --- /dev/null +++ b/lib/erl/lib/thrift/include/transport/tTransportFactory.hrl @@ -0,0 +1,7 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-record(tTransportFactory, {}). diff --git a/lib/erl/lib/thrift/server.sh b/lib/erl/lib/thrift/server.sh new file mode 100755 index 00000000..c02c0e4e --- /dev/null +++ b/lib/erl/lib/thrift/server.sh @@ -0,0 +1,5 @@ +#!/bin/sh +echo "Compiling user/ and tutorial/gen-erl/..." +mkdir ebin-user +erlc -I include -I tutorial/gen-erl -o ebin-user user/*.erl tutorial/gen-erl/*.erl && +erl -pa ebin -pa ebin-user -s application start thrift # -s nh start diff --git a/lib/erl/lib/thrift/src/Makefile b/lib/erl/lib/thrift/src/Makefile new file mode 100644 index 00000000..29352c82 --- /dev/null +++ b/lib/erl/lib/thrift/src/Makefile @@ -0,0 +1,112 @@ +# $Id: Makefile,v 1.3 2004/08/13 16:35:59 mlogan Exp $ +# +include ../../../build/otp.mk +include ../../../build/colors.mk +include ../../../build/buildtargets.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- + +include ../vsn.mk +APP_NAME=thrift +PFX=thrift +VSN=$(THRIFT_VSN) + +# ---------------------------------------------------- +# Install directory specification +# WARNING: INSTALL_DIR the command to install a directory. +# INSTALL_DST is the target directory +# ---------------------------------------------------- +INSTALL_DST = $(ERLANG_OTP)/lib/$(APP_NAME)-$(VSN) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- + + +MODULES = $(shell find -name \*.erl | sed s:^\\./:: | sed s/\\.erl//) +MODULES_STRING_LIST = $(shell find -name \*.erl | sed s:^\\./:\": | sed s/\\.erl/\",/) + +HRL_FILES= +INTERNAL_HRL_FILES= $(APP_NAME).hrl +ERL_FILES= $(MODULES:%=%.erl) +DOC_FILES=$(ERL_FILES) + +APP_FILE= $(APP_NAME).app +APPUP_FILE= $(APP_NAME).appup + +APP_SRC= $(APP_FILE).src +APPUP_SRC= $(APPUP_FILE).src + +APP_TARGET= $(EBIN)/$(APP_FILE) +APPUP_TARGET= $(EBIN)/$(APPUP_FILE) + +BEAMS= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) +TARGET_FILES= $(BEAMS) $(APP_TARGET) $(APPUP_TARGET) + +WEB_TARGET=/var/yaws/www/$(APP_NAME) + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- + +ERL_FLAGS += +ERL_COMPILE_FLAGS += -I../include -I../../fslib/include -I../../system_status/include + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +all debug opt: $(EBIN) $(TARGET_FILES) + +#$(EBIN)/rm_logger.beam: $(APP_NAME).hrl +include ../../../build/docs.mk + +# Note: In the open-source build clean must not destroy the preloaded +# beam files. +clean: + rm -f $(TARGET_FILES) + rm -f core + rm -rf $(EBIN) + rm -rf *html + +$(EBIN): + mkdir $(EBIN) + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + +$(APP_TARGET): $(APP_SRC) ../vsn.mk $(BEAMS) + sed -e 's;%VSN%;$(VSN);' \ + -e 's;%PFX%;$(PFX);' \ + -e 's;%APP_NAME%;$(APP_NAME);' \ + -e 's;%MODULES%;%MODULES%$(MODULES_STRING_LIST);' \ + $< > $<".tmp" + sed -e 's/%MODULES%\(.*\),/\1/' \ + $<".tmp" > $@ + rm $<".tmp" + + +$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +$(WEB_TARGET): ../markup/* + rm -rf $(WEB_TARGET) + mkdir $(WEB_TARGET) + cp -r ../markup/ $(WEB_TARGET) + cp -r ../skins/ $(WEB_TARGET) + +# ---------------------------------------------------- +# Install Target +# ---------------------------------------------------- + +install: all $(WEB_TARGET) +# $(INSTALL_DIR) $(INSTALL_DST)/src +# $(INSTALL_DATA) $(ERL_FILES) $(INSTALL_DST)/src +# $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(INSTALL_DST)/src +# $(INSTALL_DIR) $(INSTALL_DST)/include +# $(INSTALL_DATA) $(HRL_FILES) $(INSTALL_DST)/include +# $(INSTALL_DIR) $(INSTALL_DST)/ebin +# $(INSTALL_DATA) $(TARGET_FILES) $(INSTALL_DST)/ebin diff --git a/lib/erl/lib/thrift/src/oop.erl b/lib/erl/lib/thrift/src/oop.erl new file mode 100644 index 00000000..bb6f34f6 --- /dev/null +++ b/lib/erl/lib/thrift/src/oop.erl @@ -0,0 +1,146 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(oop). + +-export([get/2, set/3, call/2, call/3, inspect/1, start_new/2]). +-export([behaviour_info/1]). + +-include("oop.hrl"). + +%%% +%%% behavior definition +%%% + +behaviour_info(callbacks) -> + [ + {attr, 4}, + {super, 0} + ]; +behaviour_info(_) -> + undefined. + +%% + +-define(TRIED, lists:reverse([TryModule|TriedRev])). + +%% no super attr defined +-define(NOSUPEROBJ, exit({missing_attr_super, {inspect(Obj), ?TRIED}})). + +-define(NOMETHOD, exit({missing_method, {Method, inspect(Obj), tl(Args), ?TRIED}})). + +-define(NOATTR, exit({missing_attr, {hd(tl(Args)), inspect(FirstObj), ?TRIED}})). + +-define(NOATTR_SET, exit({missing_attr, {Field, inspect(Obj), ".." %% TODO: give a backtrace + }})). + + +%%% get(Obj, Field) -> term() +%%% looks up Field in Obj or its ancestor objects + +get(Obj, Field) -> + call(Obj, attr, [get, Field, get]). + +set(Obj, Field, Value) -> %% TODO: could be tail-recursive + Module = ?CLASS(Obj), + try + Module:attr(Obj, set, Field, Value) + catch + error:Kind when Kind == undef; Kind == function_clause -> + case get_superobject(Obj) of + { ok, Superobj } -> + Super1 = set(Superobj, Field, Value), + try + Module:attr(Obj, set, super, Super1) + catch %% TODO(cpiro): remove check + X -> exit({burnsauce, X}) + end; + none -> + ?NOATTR_SET + end + end. + + +%%% C++ <-> Erlang +%%% classes modules +%%% class b : public a a:super() -> b. +%%% + +get_superobject(Obj) -> + try + {ok, (?CLASS(Obj)):attr(Obj, get, super, get)} + catch + error:Kind when Kind == undef; Kind == function_clause -> + none + end. + +call(Obj, Method, ArgsProper) -> + %% io:format("call called: Obj=~p Method=~p ArgsProper=~p~n", [oop:inspect(Obj), Method, ArgsProper]), + Args = [Obj|ArgsProper], %% prepend This to args + TryModule = ?CLASS(Obj), + call_loop(Obj, Method, Args, TryModule, [], Obj). + +call(Obj, Method) -> + call(Obj, Method, []). + +call_loop(Obj, Method, Args, TryModule, TriedRev, FirstObj) -> + try + %% io:format("call_loop~n ~p~n ~p~n ~p~n ~p~n ~n", [Obj, Method, Args, TryModule]), + apply(TryModule, Method, Args) + catch + error:Kind when Kind == undef; Kind == function_clause -> + case { TryModule:super(), Method } of + { none, attr } -> + ?NOATTR; + + { none, _ } -> + ?NOMETHOD; + + { Superclass, attr } -> + %% look for attrs in the "super object" + + case get_superobject(Obj) of + {ok, Superobj} when (TryModule == ?CLASS(Obj)) -> + %% replace This with Superobj + NewArgs = [Superobj|tl(Args)], + call_loop(Superobj, Method, NewArgs, + Superclass, [TryModule|TriedRev], FirstObj); + + {ok, _Superobj} -> % failed guard TODO(cpiro): removeme + exit(oh_noes); + + none -> ?NOSUPEROBJ + end; + + { SuperClass, _ } -> + call_loop(Obj, Method, Args, + SuperClass, [TryModule|TriedRev], FirstObj) + end + end. + +inspect(Obj) -> + DeepList = inspect_loop(Obj, "#<"), + lists:flatten(DeepList). + +inspect_loop(Obj, Str) -> + New = + atom_to_list(?CLASS(Obj)) ++ + ": " ++ + (?CLASS(Obj)):inspect(Obj), + + case get_superobject(Obj) of + { ok, Superobj } -> + inspect_loop(Superobj, Str ++ New ++ " | "); + none -> + Str ++ New ++ ">" + end. + +%% TODO: voids take only ok as return? +start_new(Class, Args) -> + case gen_server:start_link(thrift_oop_server, {Class, Args}, []) of + {ok, Pid} -> + Pid + end. diff --git a/lib/erl/lib/thrift/src/protocol/tBinaryProtocol.erl b/lib/erl/lib/thrift/src/protocol/tBinaryProtocol.erl new file mode 100644 index 00000000..b7452984 --- /dev/null +++ b/lib/erl/lib/thrift/src/protocol/tBinaryProtocol.erl @@ -0,0 +1,214 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(tBinaryProtocol). + +-include("oop.hrl"). + +-include("thrift.hrl"). +-include("protocol/tProtocolException.hrl"). +-include("protocol/tBinaryProtocol.hrl"). + +-behavior(oop). + +-export([attr/4, super/0, inspect/1]). + +-export([ + new/1, + + writeMessageBegin/4, + writeFieldBegin/4, writeFieldStop/1, + writeMapBegin/4, + writeListBegin/3, + writeSetBegin/3, + + writeBool/2, writeByte/2, writeI16/2, writeI32/2, + writeI64/2, writeDouble/2, writeString/2, + + readMessageBegin/1, + readFieldBegin/1, + readMapBegin/1, + readListBegin/1, + readSetBegin/1, + + readBool/1, readByte/1, readI16/1, readI32/1, + readI64/1, readDouble/1, readString/1 +]). + +%%% +%%% define attributes +%%% 'super' is required unless ?MODULE is a base class +%%% + +?DEFINE_ATTR(super). + +%%% +%%% behavior callbacks +%%% + +%%% super() -> SuperModule = atom() +%%% | none + +super() -> + tProtocol. + +%%% inspect(This) -> string() + +inspect(_This) -> + "". + +%%% +%%% class methods +%%% + +new(Trans) -> + Super = (super()):new(Trans), + #?MODULE{super=Super}. + +%%% +%%% instance methods +%%% + +writeMessageBegin(This, Name, Type, Seqid) -> + ?L1(writeI32, ?VERSION_1 bor Type), + ?L1(writeString, Name), + ?L1(writeI32, Seqid), + ok. + +writeFieldBegin(This, _Name, Type, Id) -> + ?L1(writeByte, Type), + ?L1(writeI16, Id), + ok. + +writeFieldStop(This) -> + ?L1(writeByte, ?tType_STOP), + ok. + +writeMapBegin(This, Ktype, Vtype, Size) -> + ?L1(writeByte, Ktype), + ?L1(writeByte, Vtype), + ?L1(writeI32, Size), + ok. + +writeListBegin(This, Etype, Size) -> + ?L1(writeByte, Etype), + ?L1(writeI32, Size), + ok. + +writeSetBegin(This, Etype, Size) -> + ?L1(writeByte, Etype), + ?L1(writeI32, Size), + ok. + +% + +writeBool(This, Bool) -> + case Bool of + true -> ?L1(writeByte, 1); + false -> ?L1(writeByte, 0) + end. + +writeByte(This, Byte) -> + Trans = oop:get(This, trans), + ?R1(Trans, write, binary_to_list(<>)). + +writeI16(This, I16) -> + Trans = oop:get(This, trans), + ?R1(Trans, write, binary_to_list(<>)). + +writeI32(This, I32) -> + Trans = oop:get(This, trans), + ?R1(Trans, write, binary_to_list(<>)). + +writeI64(This, I64) -> + Trans = oop:get(This, trans), + ?R1(Trans, write, binary_to_list(<>)). + +writeDouble(This, Double) -> + Trans = oop:get(This, trans), + ?R1(Trans, write, binary_to_list(<>)). + +writeString(This, Str) -> + Trans = oop:get(This, trans), + ?L1(writeI32, length(Str)), + ?R1(Trans, write, Str). + +% + +readMessageBegin(This) -> + Version = ?L0(readI32), + if + (Version band ?VERSION_MASK) /= ?VERSION_1 -> + throw(tProtocolException:new(?tProtocolException_BAD_VERSION, + "Missing version identifier")); + true -> ok + end, + Type = Version band 16#000000ff, + Name = ?L0(readString), + Seqid = ?L0(readI32), + { Name, Type, Seqid }. + +readFieldBegin(This) -> + Type = ?L0(readByte), + case Type of + ?tType_STOP -> + { nil, Type, 0 }; % WATCH + _ -> + Id = ?L0(readI16), + { nil, Type, Id } + end. + +readMapBegin(This) -> + Ktype = ?L0(readByte), + Vtype = ?L0(readByte), + Size = ?L0(readI32), + { Ktype, Vtype, Size }. + +readListBegin(This) -> + Etype = ?L0(readByte), + Size = ?L0(readI32), + { Etype, Size }. + +readSetBegin(This) -> + Etype = ?L0(readByte), + Size = ?L0(readI32), + { Etype, Size }. + +% + +readBool(This) -> + Byte = ?L0(readByte), + (Byte /= 0). + +readByte(This) -> + Trans = oop:get(This, trans), + <> = ?R1(Trans, readAll, 1), + Val. + +readI16(This) -> + Trans = oop:get(This, trans), + <> = ?R1(Trans, readAll, 2), + Val. + +readI32(This) -> + Trans = oop:get(This, trans), + <> = ?R1(Trans, readAll, 4), + Val. + +readI64(This) -> + Trans = oop:get(This, trans), + <> = ?R1(Trans, readAll, 8), + Val. + +readDouble(This) -> + Trans = oop:get(This, trans), + <> = ?R1(Trans, readAll, 8), + Val. + +readString(This) -> + Trans = oop:get(This, trans), + Sz = ?L0(readI32), + binary_to_list(?R1(Trans, readAll, Sz)). diff --git a/lib/erl/lib/thrift/src/protocol/tBinaryProtocolFactory.erl b/lib/erl/lib/thrift/src/protocol/tBinaryProtocolFactory.erl new file mode 100644 index 00000000..ff7fa565 --- /dev/null +++ b/lib/erl/lib/thrift/src/protocol/tBinaryProtocolFactory.erl @@ -0,0 +1,57 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(tBinaryProtocolFactory). + +-include("oop.hrl"). + +-include("thrift.hrl"). +-include("protocol/tBinaryProtocol.hrl"). +-include("protocol/tBinaryProtocolFactory.hrl"). + +-behavior(oop). + +-export([attr/4, super/0, inspect/1]). + +-export([new/0, getProtocol/2]). + +%%% +%%% define attributes +%%% 'super' is required unless ?MODULE is a base class +%%% + +?DEFINE_ATTR(super). + +%%% +%%% behavior callbacks +%%% + +%%% super() -> SuperModule = atom() +%%% | none + +super() -> + tProtocolFactory. + +%%% inspect(This) -> string() + +inspect(_This) -> + "". + +%%% +%%% class methods +%%% + +new() -> + Super = (super()):new(), + #?MODULE{super=Super}. + +%%% +%%% instance methods +%%% + +getProtocol(_This, Trans) -> + oop:start_new(tBinaryProtocol, [Trans]). + diff --git a/lib/erl/lib/thrift/src/protocol/tProtocol.erl b/lib/erl/lib/thrift/src/protocol/tProtocol.erl new file mode 100644 index 00000000..8900c5dc --- /dev/null +++ b/lib/erl/lib/thrift/src/protocol/tProtocol.erl @@ -0,0 +1,217 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(tProtocol). + +-include("oop.hrl"). + +-include("thrift.hrl"). +-include("protocol/tProtocol.hrl"). + +-behavior(oop). + +-export([attr/4, super/0, inspect/1]). + +%% -export([interface/1]). %% + +-export([ + new/1, + skip/2, + + writeMessageBegin/4, writeMessageEnd/1, + writeStructBegin/2, writeStructEnd/1, + writeFieldBegin/4, writeFieldEnd/1, writeFieldStop/1, + writeMapBegin/4, writeMapEnd/1, + writeListBegin/3, writeListEnd/1, + writeSetBegin/3, writeSetEnd/1, + + writeBool/2, writeByte/2, writeI16/2, writeI32/2, + writeI64/2, writeDouble/2, writeString/2, + + readMessageBegin/1, readMessageEnd/1, + readStructBegin/1, readStructEnd/1, + readFieldBegin/1, readFieldEnd/1, + readMapBegin/1, readMapEnd/1, + readListBegin/1, readListEnd/1, + readSetBegin/1, readSetEnd/1, + + readBool/1, readByte/1, readI16/1, readI32/1, + readI64/1, readDouble/1, readString/1 +]). + +%%% +%%% server interface +%%% + +%% %%% modules we can instantiate from the server %% +%% interface(subclasses) -> %% +%% [ %% +%% tBinaryProtocol %% +%% ]; %% +%% %% +%% %%% synchronous calls to pass %% +%% interface(call) -> %% +%% [ %% +%% skip, %% +%% %% +%% writeMessageBegin, writeMessageEnd, %% +%% writeStructBegin, writeStructEnd, %% +%% writeFieldBegin, writeFieldEnd, writeFieldStop, %% +%% writeMapBegin, writeMapEnd, %% +%% writeListBegin, writeListEnd, %% +%% writeSetBegin, writeSetEnd, %% +%% %% +%% writeBool, writeByte, writeI16, writeI32, %% +%% writeI64, writeDouble, writeString, %% +%% %% +%% readMessageBegin, readMessageEnd, %% +%% readStructBegin, readStructEnd, %% +%% readFieldBegin, readFieldEnd, %% +%% readMapBegin, readMapEnd, %% +%% readListBegin, readListEnd, %% +%% readSetBegin, readSetEnd, %% +%% %% +%% readBool, readByte, readI16, readI32, %% +%% readI64, readDouble, readString %% +%% ]; %% +%% %% +%% %%% asynchronous casts to pass %% +%% interface(cast) -> %% +%% []. %% + +%%% +%%% define attributes +%%% 'super' is required unless ?MODULE is a base class +%%% + +?DEFINE_ATTR(trans). + +%%% +%%% behavior callbacks +%%% + +%%% super() -> SuperModule = atom() +%%% | none + +super() -> + none. + +%%% inspect(This) -> string() + +inspect(This) -> + ?FORMAT_ATTR(trans). + +%%% +%%% class methods +%%% + +new(Trans) -> + #?MODULE{trans=Trans}. + +%%% +%%% instance methods +%%% + +writeMessageBegin(_This, _Name, _Type, _Seqid) -> ok. +writeMessageEnd(_This) -> ok. +writeStructBegin(_This, _Name) -> ok. +writeStructEnd(_This) -> ok. +writeFieldBegin(_This, _Name, _Type, _Id) -> ok. +writeFieldEnd(_This) -> ok. +writeFieldStop(_This) -> ok. +writeMapBegin(_This, _Ktype, _Vtype, _Size) -> ok. +writeMapEnd(_This) -> ok. +writeListBegin(_This, _Etype, _Size) -> ok. +writeListEnd(_This) -> ok. +writeSetBegin(_This, _Etype, _Size) -> ok. +writeSetEnd(_This) -> ok. + +writeBool(_This, _Value) -> ok. +writeByte(_This, _Value) -> ok. +writeI16(_This, _Value) -> ok. +writeI32(_This, _Value) -> ok. +writeI64(_This, _Value) -> ok. +writeDouble(_This, _Value) -> ok. +writeString(_This, _Value) -> ok. + +readMessageBegin(_This) -> ok. +readMessageEnd(_This) -> ok. +readStructBegin(_This) -> ok. +readStructEnd(_This) -> ok. +readFieldBegin(_This) -> ok. +readFieldEnd(_This) -> ok. +readMapBegin(_This) -> ok. +readMapEnd(_This) -> ok. +readListBegin(_This) -> ok. +readListEnd(_This) -> ok. +readSetBegin(_This) -> ok. +readSetEnd(_This) -> ok. + +readBool(_This) -> ok. +readByte(_This) -> ok. +readI16(_This) -> ok. +readI32(_This) -> ok. +readI64(_This) -> ok. +readDouble(_This) -> ok. +readString(_This) -> ok. + +skip(This, Type) -> + case Type of + ?tType_STOP -> nil; % WATCH + ?tType_BOOL -> ?L0(readBool); + ?tType_BYTE -> ?L0(readByte); + ?tType_I16 -> ?L0(readI16); + ?tType_I32 -> ?L0(readI32); + ?tType_I64 -> ?L0(readI64); + ?tType_DOUBLE -> ?L0(readDouble); + ?tType_STRING -> ?L0(readString); + + ?tType_STRUCT -> + ?L0(readStructBegin), + skip_struct_loop(This), + + %% cpiro: this isn't here in the original tprotocol.rb, but i think it's a bug + ?L0(readStructEnd); + + ?tType_MAP -> + {Ktype, Vtype, Size} = ?L0(readMapBegin), + skip_map_repeat(This, Ktype, Vtype, Size), + ?L0(readMapEnd); + + ?tType_SET -> + {Etype, Size} = ?L0(readSetBegin), + skip_set_repeat(This, Etype, Size), + ?L0(readSetEnd); + + ?tType_LIST -> + {Etype, Size} = ?L0(readListBegin), + skip_set_repeat(This, Etype, Size), % [sic] skipping same as for SET + ?L0(readListEnd) + end. + +skip_struct_loop(This) -> + { _Name, Type, _Id } = ?L0(readFieldBegin), + if + Type == ?tType_STOP -> + ok; + + true -> + ?L1(skip, Type), + ?L0(readFieldEnd), + + %% cpiro: this is here in original tprotocol.rb, but i think it's a bug + % ?L0(readStructEnd), + skip_struct_loop(This) + end. + +skip_map_repeat(This, Ktype, Vtype, Times) -> + ?L1(skip, Ktype), + ?L1(skip, Vtype), + skip_map_repeat(This, Ktype, Vtype, Times-1). + +skip_set_repeat(This, Etype, Times) -> + ?L1(skip, Etype), + skip_set_repeat(This, Etype, Times-1). diff --git a/lib/erl/lib/thrift/src/protocol/tProtocolException.erl b/lib/erl/lib/thrift/src/protocol/tProtocolException.erl new file mode 100644 index 00000000..d926aff3 --- /dev/null +++ b/lib/erl/lib/thrift/src/protocol/tProtocolException.erl @@ -0,0 +1,58 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(tProtocolException). + +-include("oop.hrl"). + +-include("thrift.hrl"). +-include("protocol/tProtocolException.hrl"). + +-behavior(oop). + +-export([attr/4, super/0, inspect/1]). + +-export([new/0, new/1, new/2]). + +%%% +%%% define attributes +%%% 'super' is required unless ?MODULE is a base class +%%% + +?DEFINE_ATTR(super); +?DEFINE_ATTR(type). + +%%% +%%% behavior callbacks +%%% + +%%% super() -> SuperModule = atom() +%%% | none + +super() -> + tException. + +%%% inspect(This) -> string() + +inspect(This) -> + ?FORMAT_ATTR(type). + +%%% +%%% class methods +%%% + +new(Type, Message) -> + Super = (super()):new(Message), + #?MODULE{super=Super, type=Type}. + +new() -> + new(?tProtocolException_UNKNOWN, undefined). +new(Type) -> + new(Type, undefined). + +%%% +%%% instance methods +%%% diff --git a/lib/erl/lib/thrift/src/protocol/tProtocolFactory.erl b/lib/erl/lib/thrift/src/protocol/tProtocolFactory.erl new file mode 100644 index 00000000..d697263c --- /dev/null +++ b/lib/erl/lib/thrift/src/protocol/tProtocolFactory.erl @@ -0,0 +1,54 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(tProtocolFactory). + +-include("oop.hrl"). + +-include("thrift.hrl"). +-include("protocol/tProtocolFactory.hrl"). + +-behavior(oop). + +-export([attr/4, super/0, inspect/1]). + +-export([new/0, getProtocol/2]). + +%%% +%%% define attributes +%%% 'super' is required unless ?MODULE is a base class +%%% + +?ATTR_DUMMY. + +%%% +%%% behavior callbacks +%%% + +%%% super() -> SuperModule = atom() +%%% | none + +super() -> + none. + +%%% inspect(This) -> string() + +inspect(_This) -> + "". + +%%% +%%% class methods +%%% + +new() -> + #?MODULE{}. + +%%% +%%% instance methods +%%% + +getProtocol(This, Trans) -> + nil. diff --git a/lib/erl/lib/thrift/src/server/tErlServer.erl b/lib/erl/lib/thrift/src/server/tErlServer.erl new file mode 100644 index 00000000..8a94709c --- /dev/null +++ b/lib/erl/lib/thrift/src/server/tErlServer.erl @@ -0,0 +1,112 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(tErlServer). + +-include("oop.hrl"). + +-include("thrift.hrl"). +-include("transport/tTransportException.hrl"). +-include("server/tErlServer.hrl"). + +-behavior(oop). + +-export([attr/4, super/0, inspect/1]). + +-export([new/6, new/5, new/4, effectful_serve/1, effectful_new_acceptor/1, catches/3]). + +%%% +%%% define attributes +%%% 'super' is required unless ?MODULE is a base class +%%% + +?DEFINE_ATTR(super); +?DEFINE_ATTR(acceptor); +?DEFINE_ATTR(listenSocket); +?DEFINE_ATTR(port). + +%%% +%%% behavior callbacks +%%% + +%%% super() -> SuperModule = atom() +%%% | none + +super() -> + tServer. + +%%% inspect(This) -> string() + +inspect(This) -> + ?FORMAT_ATTR(acceptor) ++ ", " ++ + ?FORMAT_ATTR(listenSocket) ++ ", " ++ + ?FORMAT_ATTR(port). + +%%% +%%% class methods +%%% + +new(Port, Handler, Processor, ServerTransport, TransportFactory, ProtocolFactory) -> + Super = (super()):new(Handler, Processor, ServerTransport, TransportFactory, ProtocolFactory), + #?MODULE{super=Super, port=Port, listenSocket=nil, acceptor=nil}. + +new(Port, Handler, Processor, ServerTransport) -> + new(Port, Handler, Processor, ServerTransport, nil, nil). + +new(Port, Handler, Processor, ServerTransport, TransportFactory) -> + new(Port, Handler, Processor, ServerTransport, TransportFactory, nil). + +% listenSocket, acceptor, port + +effectful_serve(This) -> + Port = oop:get(This, port), + + Options = [binary, {packet, 0}, {active, false}], + + %% listen + case gen_tcp:listen(Port, Options) of + {ok, ListenSocket} -> + + This1 = oop:set(This, listenSocket, ListenSocket), + + %% spawn acceptor + {_Acceptor, This2} = effectful_new_acceptor(This1), + + {ok, This2} + end. + +effectful_new_acceptor(This) -> + ListenSocket = oop:get(This, listenSocket), + Processor = oop:get(This, processor), %% cpiro: generated processor, not the "actual" processor + Handler = oop:get(This, handler), + + TF = oop:get(This, transportFactory), + PF = oop:get(This, protocolFactory), + + tErlAcceptor = oop:get(This, serverTransport), %% cpiro: only supported ServerTransport + + ServerPid = self(), + Acceptor = oop:start_new(tErlAcceptor, [ServerPid, TF, PF]), + ?C3(Acceptor, accept, ListenSocket, Processor, Handler), + + This1 = oop:set(This, acceptor, Acceptor), + + {Acceptor, This1}. + +catches(This, Pid, acceptor_done) -> + ok. + +%% %% The current acceptor has died, wait a little and try again %% +%% handle_info({'EXIT', Pid, _Abnormal}, #state{acceptor=Pid} = State) -> %% +%% timer:sleep(2000), %% +%% iserve_socket:start_link(self(), State#state.listen_socket, State#state.port), %% +%% {noreply,State}; %% + +%% terminate(Reason, State) -> %% +%% error_logger:info_msg( "Terminating error: ~p~n", [Reason]), % added %% +%% gen_tcp:close(State#state.listen_socket), %% +%% ok. %% +%% %% diff --git a/lib/erl/lib/thrift/src/server/tServer.erl b/lib/erl/lib/thrift/src/server/tServer.erl new file mode 100644 index 00000000..23aef22e --- /dev/null +++ b/lib/erl/lib/thrift/src/server/tServer.erl @@ -0,0 +1,81 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(tServer). + +-include("oop.hrl"). + +-include("thrift.hrl"). +-include("server/tServer.hrl"). +-include("transport/tTransportFactory.hrl"). +-include("protocol/tBinaryProtocolFactory.hrl"). + +-behavior(oop). + +-export([attr/4, super/0, inspect/1]). + +-export([new/5, new/4, new/3, serve/1]). + +%%% +%%% define attributes +%%% 'super' is required unless ?MODULE is a base class +%%% + +?DEFINE_ATTR(handler); +?DEFINE_ATTR(processor); +?DEFINE_ATTR(serverTransport); +?DEFINE_ATTR(transportFactory); +?DEFINE_ATTR(protocolFactory). + +%%% +%%% behavior callbacks +%%% + +%%% super() -> SuperModule = atom() +%%% | none + +super() -> + none. + +%%% inspect(This) -> string() + +inspect(This) -> + ?FORMAT_ATTR(handler) ++ ", " ++ + ?FORMAT_ATTR(processor) ++ ", " ++ + ?FORMAT_ATTR(serverTransport) ++ ", " ++ + ?FORMAT_ATTR(transportFactory) ++ ", " ++ + ?FORMAT_ATTR(protocolFactory). + +%%% +%%% class methods +%%% + +new(Handler, Processor, ServerTransport, TransportFactory, ProtocolFactory) -> + #?MODULE{handler=Handler, processor=Processor, serverTransport=ServerTransport, + + %% much ado about nothing but + %% subclasses pass nil too + transportFactory = + case TransportFactory of + nil -> tTransportFactory:new(); + _ -> TransportFactory + end, + + protocolFactory = + case ProtocolFactory of + nil -> tBinaryProtocolFactory:new(); + _ -> ProtocolFactory + end +}. + +new(Handler, Processor, ServerTransport) -> + new(Handler, Processor, ServerTransport, nil, nil). + +new(Handler, Processor, ServerTransport, TransportFactory) -> + new(Handler, Processor, ServerTransport, TransportFactory, nil). + +serve(_This) -> + ok. diff --git a/lib/erl/lib/thrift/src/server/tSimpleServer.erl b/lib/erl/lib/thrift/src/server/tSimpleServer.erl new file mode 100644 index 00000000..5b457cdd --- /dev/null +++ b/lib/erl/lib/thrift/src/server/tSimpleServer.erl @@ -0,0 +1,106 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(tSimpleServer). + +-include("oop.hrl"). + +-include("thrift.hrl"). +-include("transport/tTransportException.hrl"). +-include("server/tSimpleServer.hrl"). + +-behavior(oop). + +-export([attr/4, super/0, inspect/1]). + +-export([new/5, new/4, new/3, serve/1]). + +%%% +%%% define attributes +%%% 'super' is required unless ?MODULE is a base class +%%% + +?DEFINE_ATTR(super). + +%%% +%%% behavior callbacks +%%% + +%%% super() -> SuperModule = atom() +%%% | none + +super() -> + tServer. + +%%% inspect(This) -> string() + +inspect(_This) -> + "". + +%%% +%%% class methods +%%% + +new(Handler, Processor, ServerTransport, TransportFactory, ProtocolFactory) -> + Super = (super()):new(Handler, Processor, ServerTransport, TransportFactory, ProtocolFactory), + #?MODULE{super=Super}. + +new(Handler, Processor, ServerTransport) -> + new(Handler, Processor, ServerTransport, nil, nil). + +new(Handler, Processor, ServerTransport, TransportFactory) -> + new(Handler, Processor, ServerTransport, TransportFactory, nil). + +% + +serve(This) -> + ST = oop:get(This, serverTransport), + ?R0(ST, effectful_listen), + + serve_loop(This). + +serve_loop(This) -> + io:format("~nready.~n", []), + + ST = oop:get(This, serverTransport), + Client = ?RT0(ST, accept, infinity), + + TF = oop:get(This, transportFactory), + Trans = ?F1(TF, getTransport, Client), %% cpiro: OPAQUE!! Trans = Client + + PF = oop:get(This, protocolFactory), + Prot = ?F1(PF, getProtocol, Trans), %% cpiro: OPAQUE!! Prot = start_new(tBinaryProtocol, [Trans]) + + io:format("client accept()ed~n", []), + + serve_loop_loop(This, Prot), % giggle loop? + + ?R0(Trans, effectful_close), + + serve_loop(This). + +serve_loop_loop(This, Prot) -> + Next = + try + Handler = oop:get(This, handler), + Processor = oop:get(This, processor), + Val = apply(Processor, process, [Handler, Prot, Prot]), %% TODO(cpiro): make processor a gen_server instance + io:format("request processed: rv=~p~n", [Val]), + loop + catch + %% TODO(cpiro) case when is_record(...) to pick out our exception + %% records vs. normal erlang throws + E when is_record(E, tTransportException) -> + io:format("tTransportException (normal-ish?)~n", []), + close; + F -> + io:format("EXCEPTION: ~p~n", [F]), + close + end, + case Next of + loop -> serve_loop_loop(This, Prot); + close -> ok + end. diff --git a/lib/erl/lib/thrift/src/tApplicationException.erl b/lib/erl/lib/thrift/src/tApplicationException.erl new file mode 100644 index 00000000..568b9c94 --- /dev/null +++ b/lib/erl/lib/thrift/src/tApplicationException.erl @@ -0,0 +1,115 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(tApplicationException). + +-include("thrift.hrl"). +-include("tApplicationException.hrl"). + +-include("oop.hrl"). + +-behavior(oop). + +-export([attr/4, super/0, inspect/1]). + +-export([new/0, new/1, new/2, read/2, write/2]). + +%%% +%%% define attributes +%%% 'super' is required unless ?MODULE is a base class +%%% + +?DEFINE_ATTR(super); +?DEFINE_ATTR(type). + +%%% +%%% behavior callbacks +%%% + +%%% super() -> SuperModule = atom() +%%% | none + +super() -> + tException. + +%%% inspect(This) -> string() + +inspect(This) -> + ?FORMAT_ATTR(type). + +%%% +%%% class methods +%%% + +new(Type, Message) -> + Super = (super()):new(Message), + #?MODULE{super=Super, type=Type}. + +new() -> new(?tApplicationException_UNKNOWN, undefined). +new(Type) -> new(Type, undefined). + +%%% +%%% instance methods +%%% + +read(This, Iprot) -> + ?R0(Iprot, readStructBegin), + read_while_loop(This, Iprot), + ?R0(Iprot, readStructEnd), + ok. + +read_while_loop(This, Iprot) -> + {_Fname, Ftype, Fid} = ?R0(Iprot, readFieldBegin), + + if + Ftype == ?tType_STOP -> + ok; + + (Fid == 1) and (Ftype == ?tType_STRING) -> + Message1 = ?R0(Iprot, readString), + This1 = oop:set(This, message, Message1), + ?R0(Iprot, readFieldEnd), + read_while_loop(This1, Iprot); + + Fid == 1 -> + ?R0(Iprot, skip), + ?R0(Iprot, readFieldEnd), + read_while_loop(This, Iprot); + + (Fid == 2) and (Ftype == ?tType_I32) -> + Type1 = ?R0(Iprot, readI32), + This1 = oop:set(This, type, Type1), + ?R0(Iprot, readFieldEnd), + read_while_loop(This1, Iprot); + + true -> + ?R0(Iprot, skip), + ?R0(Iprot, readFieldEnd), + read_while_loop(This, Iprot) + end. + +write(This, Oprot) -> + ?R1(Oprot, writeStructBegin, "tApplicationException"), + Message = oop:get(This, message), + Type = oop:get(This, type), + + if Message /= undefined -> + ?R3(Oprot, writeFieldBegin, "message", ?tType_STRING, 1), + ?R1(Oprot, writeString, Message), + ?R0(Oprot, writeFieldEnd); + true -> ok + end, + + if Type /= undefined -> + ?R3(Oprot, writeFieldBegin, "type", ?tType_I32, 2), + ?R1(Oprot, writeI32, Type), + ?R0(Oprot, writeFieldEnd); + true -> ok + end, + + ?R0(Oprot, writeFieldStop), + ?R0(Oprot, writeStructEnd), + ok. diff --git a/lib/erl/lib/thrift/src/tErlProcessor.erl b/lib/erl/lib/thrift/src/tErlProcessor.erl new file mode 100644 index 00000000..a95ef536 --- /dev/null +++ b/lib/erl/lib/thrift/src/tErlProcessor.erl @@ -0,0 +1,62 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(tErlProcessor). + +-include("oop.hrl"). +-include("tErlProcessor.hrl"). + +-behavior(oop). + +-export([attr/4, super/0, inspect/1]). + +-export([new/2, process/3]). + +%%% +%%% define attributes +%%% 'super' is required unless ?MODULE is a base class +%%% + +?DEFINE_ATTR(super); +?DEFINE_ATTR(generatedProcessor); +?DEFINE_ATTR(handler). + +%%% +%%% behavior callbacks +%%% + +%%% super() -> SuperModule = atom() +%%% | none + +super() -> + tProcessor. + +%%% inspect(This) -> string() + +inspect(This) -> + ?FORMAT_ATTR(generatedProcessor) ++ ", " ++ + ?FORMAT_ATTR(handler). + +%%% +%%% class methods +%%% + +new(GP, Handler) -> + Super = (super()):new(), + #?MODULE{super = Super, generatedProcessor = GP, handler = Handler}. + +%% processor is generated code +%% handler is user code + +%%% +%%% instance methods +%%% + +process(This, Iprot, Oprot) -> + GP = oop:get(This, generatedProcessor), + Handler = oop:get(This, handler), + + apply(GP, process, [Handler, Iprot, Oprot]). diff --git a/lib/erl/lib/thrift/src/tException.erl b/lib/erl/lib/thrift/src/tException.erl new file mode 100644 index 00000000..0ec4c948 --- /dev/null +++ b/lib/erl/lib/thrift/src/tException.erl @@ -0,0 +1,50 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(tException). + +-include("oop.hrl"). +-include("tException.hrl"). + +-behavior(oop). + +-export([attr/4, super/0, inspect/1]). + +-export([new/1]). + +%%% +%%% define attributes +%%% 'super' is required unless ?MODULE is a base class +%%% + +?DEFINE_ATTR(message). + +%%% +%%% behavior callbacks +%%% + +%%% super() -> SuperModule = atom() +%%% | none + +super() -> + none. + +%%% inspect(This) -> string() + +inspect(This) -> + ?FORMAT_ATTR(message). + +%%% +%%% class methods +%%% + +new(Message) -> + #?MODULE{message=Message}. + +%%% +%%% instance methods +%%% + diff --git a/lib/erl/lib/thrift/src/tProcessor.erl b/lib/erl/lib/thrift/src/tProcessor.erl new file mode 100644 index 00000000..003748a7 --- /dev/null +++ b/lib/erl/lib/thrift/src/tProcessor.erl @@ -0,0 +1,50 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(tProcessor). + +-include("oop.hrl"). +-include("tProcessor.hrl"). + +-behavior(oop). + +-export([attr/4, super/0, inspect/1]). + +-export([new/0]). + +%%% +%%% define attributes +%%% 'super' is required unless ?MODULE is a base class +%%% + +?ATTR_DUMMY. + +%%% +%%% behavior callbacks +%%% + +%%% super() -> SuperModule = atom() +%%% | none + +super() -> + none. + +%%% inspect(This) -> string() + +inspect(_This) -> + "". + +%%% +%%% class methods +%%% + +new() -> + #?MODULE{}. + +%%% +%%% instance methods +%%% + diff --git a/lib/erl/lib/thrift/src/thrift.app.src b/lib/erl/lib/thrift/src/thrift.app.src new file mode 100755 index 00000000..dc2926a0 --- /dev/null +++ b/lib/erl/lib/thrift/src/thrift.app.src @@ -0,0 +1,41 @@ +%%% -*- mode:erlang -*- +{application, %APP_NAME%, + [ + % A quick description of the application. + {description, "Thrift bindings"}, + + % The version of the applicaton + {vsn, "%VSN%"}, + + % All modules used by the application. + {modules, + [ + %MODULES% + ]}, + + % All of the registered names the application uses. This can be ignored. + {registered, []}, + + % Applications that are to be started prior to this one. This can be ignored + % leave it alone unless you understand it well and let the .rel files in + % your release handle this. + {applications, + [ + kernel, + stdlib + ]}, + + % OTP application loader will load, but not start, included apps. Again + % this can be ignored as well. To load but not start an application it + % is easier to include it in the .rel file followed by the atom 'none' + {included_applications, []}, + + % configuration parameters similar to those in the config file specified + % on the command line. can be fetched with gas:get_env + {env, []}, + + % The Module and Args used to start this application. + {mod, {%APP_NAME%, []}} + ] +}. + diff --git a/lib/erl/lib/thrift/src/thrift.appup.src b/lib/erl/lib/thrift/src/thrift.appup.src new file mode 100755 index 00000000..54a63833 --- /dev/null +++ b/lib/erl/lib/thrift/src/thrift.appup.src @@ -0,0 +1 @@ +{"%VSN%",[],[]}. diff --git a/lib/erl/lib/thrift/src/thrift_oop_server.erl b/lib/erl/lib/thrift/src/thrift_oop_server.erl new file mode 100644 index 00000000..8fc91238 --- /dev/null +++ b/lib/erl/lib/thrift/src/thrift_oop_server.erl @@ -0,0 +1,213 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +%%%------------------------------------------------------------------- +%%% @doc +%%% @end +%%%------------------------------------------------------------------- +-module(thrift_oop_server). + +-behaviour(gen_server). +%%-------------------------------------------------------------------- +%% Include files +%%-------------------------------------------------------------------- +-include("oop.hrl"). + +-include("thrift.hrl"). + +%%-------------------------------------------------------------------- +%% External exports +%%-------------------------------------------------------------------- +-export([ + start_link/0, + stop/0 + ]). + +%%-------------------------------------------------------------------- +%% gen_server callbacks +%%-------------------------------------------------------------------- +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). + +%%-------------------------------------------------------------------- +%% record definitions +%%-------------------------------------------------------------------- + +%%-------------------------------------------------------------------- +%% macro definitions +%%-------------------------------------------------------------------- +-define(SERVER, ?MODULE). + +%%==================================================================== +%% External functions +%%==================================================================== +%%-------------------------------------------------------------------- +%% @doc Starts the server. +%% @spec start_link() -> {ok, pid()} | {error, Reason} +%% @end +%%-------------------------------------------------------------------- +start_link() -> + gen_server:start_link({local, ?SERVER}, ?MODULE, [], []). + +%%-------------------------------------------------------------------- +%% @doc Stops the server. +%% @spec stop() -> ok +%% @end +%%-------------------------------------------------------------------- +stop() -> + gen_server:cast(?SERVER, stop). + +%%==================================================================== +%% Server functions +%%==================================================================== + +%%-------------------------------------------------------------------- +%% Function: init/1 +%% Description: Initiates the server +%% Returns: {ok, State} | +%% {ok, State, Timeout} | +%% ignore | +%% {stop, Reason} +%%-------------------------------------------------------------------- + +unparenth(Args) -> + Args. + +init({Class, Args}) -> + process_flag(trap_exit, true), + if + true -> % lists:member(Class, Class:interface(subclasses)) -> + io:format("oop_server init: ~p := ~p:new(~p)~n", [self(), Class, unparenth(Args)]), + State = apply(Class, new, Args), % TODO(cpiro): try catch? + io:format(" =>~p~n", [oop:inspect(State)]), + {ok, State} + + %% true -> %% + %% {stop, invalid_subclass} %% + end; +init(_) -> + {stop, invalid_params}. + +%%-------------------------------------------------------------------- +%% Function: handle_call/3 +%% Description: Handling call messages +%% Returns: {reply, Reply, State} | +%% {reply, Reply, State, Timeout} | +%% {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, Reply, State} | (terminate/2 is called) +%% {stop, Reason, State} (terminate/2 is called) +%%-------------------------------------------------------------------- + +handle_call(Request, From, State) -> + handle_either(call, Request, From, State). + +%%-------------------------------------------------------------------- +%% Function: handle_cast/2 +%% Description: Handling cast messages +%% Returns: {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} (terminate/2 is called) +%%-------------------------------------------------------------------- + +handle_cast(stop, State) -> + {stop, normal, State}; + +handle_cast({Method, Args}, State) -> + handle_either(cast, {Method, Args}, undefined, State). + +-define(REPLY(Value, State), + case Type of + call -> {reply, Value, State}; + cast -> {noreply, State} + end +). + +handle_either(Type, Request, From, State) -> + %% io:format("~p: ~p~n", [?SERVER, oop:inspect(State)]), + %% io:format(" handle_call(Request=~p, From=~p, State)~n", [Request, From]), + + case Request of + {get, [Field]} -> + Value = oop:get(State, Field), + ?REPLY(Value, State); + + {set, [Field, Value]} -> + State1 = oop:set(State, Field, Value), + ?REPLY(Value, State1); + + {Method, Args} -> + handle_method(Type, State, Method, Args); + + _ -> + io:format(" ERROR: Request = ~p nomatch {Method, Args}~n", [Request]), + %% {stop, server_error, State} + {reply, server_error, State} + end. + +handle_method(Type, State, Method, Args) -> + %% is an effectful call? + Is_effectful = lists:prefix("effectful_", atom_to_list(Method)), + Call = oop:call(State, Method, Args), + + %% TODO(cpiro): maybe add error handling here? = catch oop:call? + + case {Is_effectful, Call} of + {true, {Retval, State1}} -> + ?REPLY(Retval, State1); + + {true, _MalformedReturn} -> + %% TODO(cpiro): bad match -- remove when we're done converting + io:format(" ERROR: oop:call(effectful_*,..,..) malformed return value ~p~n", + [_MalformedReturn]), + %% {stop, server_error, State} + {noreply, State}; + + {false, Retval} -> + ?REPLY(Retval, State) + end. + +%%-------------------------------------------------------------------- +%% Function: handle_info/2 +%% Description: Handling all non call/cast messages +%% Returns: {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} (terminate/2 is called) +%%-------------------------------------------------------------------- +handle_info({'EXIT', Pid, Except} = All, State) -> + case catch oop:call(State, catches, [Pid, Except]) of + {'EXIT', MM} when element(1,MM) == missing_method -> + io:format("UNHANDLED ~p by ~p!~n", [All, self()]), + %% not caught + {stop, All, State}; + _IsCaught -> + %% caught and handled + {noreply, State} + end; + +handle_info(Info, State) -> + io:format("~p infoED!: ~p~n", [self(), Info]), + {noreply, State}. + +%%-------------------------------------------------------------------- +%% Function: terminate/2 +%% Description: Shutdown the server +%% Returns: any (ignored by gen_server) +%%-------------------------------------------------------------------- +terminate(Reason, State) -> + io:format("~p terminated!: ~p~n", [self(), Reason]), + ok. + +%%-------------------------------------------------------------------- +%% Func: code_change/3 +%% Purpose: Convert process state when code is changed +%% Returns: {ok, NewState} + %%-------------------------------------------------------------------- +code_change(OldVsn, State, Extra) -> + {ok, State}. + +%%==================================================================== +%%% Internal functions +%%==================================================================== diff --git a/lib/erl/lib/thrift/src/transport/tBufferedTransport.erl b/lib/erl/lib/thrift/src/transport/tBufferedTransport.erl new file mode 100644 index 00000000..48d9fba3 --- /dev/null +++ b/lib/erl/lib/thrift/src/transport/tBufferedTransport.erl @@ -0,0 +1,84 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(tBufferedTransport). + +-include("oop.hrl"). + +-include("thrift.hrl"). +-include("transport/tBufferedTransport.hrl"). + +-behavior(oop). + +-export([attr/4, super/0, inspect/1]). + +-export([new/1, isOpen/1, open/1, close/1, read/2, effectful_write/2, effectful_flush/1]). + +%%% +%%% define attributes +%%% 'super' is required unless ?MODULE is a base class +%%% + +?DEFINE_ATTR(super); +?DEFINE_ATTR(transport); +?DEFINE_ATTR(wbuf). + +%%% +%%% behavior callbacks +%%% + +%%% super() -> SuperModule = atom() +%%% | none + +super() -> + tTransport. + +%%% inspect(This) -> string() + +inspect(This) -> + ?FORMAT_ATTR(transport) ++ + ?FORMAT_ATTR(wbuf). + +%%% +%%% class methods +%%% + +new(Transport) -> + Super = (super()):new(), + #?MODULE{super=Super, transport=Transport, wbuf=""}. + +%%% +%%% instance methods +%%% + +isOpen(This) -> + Transport = oop:get(This, transport), + ?R0(Transport, isOpen). + +open(This) -> + Transport = oop:get(This, transport), + ?R0(Transport, open). + +close(This) -> + Transport = oop:get(This, transport), + ?R0(Transport, close). + +read(This, Sz) -> + Transport = oop:get(This, transport), + ?R1(Transport, read, Sz). + +effectful_write(This, Buf) -> % be sure to rebind This to the retval + Wbuf = oop:get(This, wbuf), + This1 = oop:set(This, wbuf, Wbuf++Buf), % TODO: ++ efficiency? + {ok, This1}. + +effectful_flush(This) -> + Wbuf = oop:get(This, wbuf), + Transport = oop:get(This, transport), + ?R1(Transport, effectful_write, Wbuf), + ?R0(Transport, effectful_flush), + This1 = oop:set(This, wbuf, ""), + {ok, This1}. diff --git a/lib/erl/lib/thrift/src/transport/tBufferedTransportFactory.erl b/lib/erl/lib/thrift/src/transport/tBufferedTransportFactory.erl new file mode 100644 index 00000000..9746aba5 --- /dev/null +++ b/lib/erl/lib/thrift/src/transport/tBufferedTransportFactory.erl @@ -0,0 +1,54 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(tBufferedTransportFactory). + +-include("oop.hrl"). +-include("transport/tBufferedTransport.hrl"). +-include("transport/tBufferedTransportFactory.hrl"). + +-behavior(oop). + +-export([attr/4, super/0, inspect/1]). + +-export([new/0, getTransport/2]). + +%%% +%%% define attributes +%%% 'super' is required unless ?MODULE is a base class +%%% + +?ATTR_DUMMY. + +%%% +%%% behavior callbacks +%%% + +%%% super() -> SuperModule = atom() +%%% | none + +super() -> + tTransportFactory. + +%%% inspect(This) -> string() + +inspect(_This) -> + "". + +%%% +%%% class methods +%%% + +new() -> + Super = (super()):new(), + #?MODULE{super=Super}. + +%%% +%%% instance methods +%%% + +getTransport(_This, Trans) -> + gen_server:start_link(tBufferedTransport, {new, [Trans]}). diff --git a/lib/erl/lib/thrift/src/transport/tErlAcceptor.erl b/lib/erl/lib/thrift/src/transport/tErlAcceptor.erl new file mode 100644 index 00000000..fd062601 --- /dev/null +++ b/lib/erl/lib/thrift/src/transport/tErlAcceptor.erl @@ -0,0 +1,226 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(tErlAcceptor). + +-include("oop.hrl"). +-include("thrift.hrl"). +-include("transport/tTransportException.hrl"). +-include("transport/tServerSocket.hrl"). +-include("transport/tErlAcceptor.hrl"). + +-behavior(oop). + +-export([attr/4, super/0, inspect/1]). + +-export([new/3, accept/4]). + +%%% +%%% define attributes +%%% 'super' is required unless ?MODULE is a base class +%%% + +?DEFINE_ATTR(super); +?DEFINE_ATTR(serverPid); +?DEFINE_ATTR(transportFactory); +?DEFINE_ATTR(protocolFactory). + +%%% +%%% behavior callbacks +%%% + +%%% super() -> SuperModule = atom() +%%% | none + +super() -> + tServerTransport. + +%%% inspect(This) -> string() + +inspect(This) -> + ?FORMAT_ATTR(serverPid) ++ ", " ++ + ?FORMAT_ATTR(transportFactory) ++ ", " ++ + ?FORMAT_ATTR(protocolFactory). + +%%% +%%% class methods +%%% + +new(ServerPid, TF, PF) -> + Super = (super()):new(), + #?MODULE{super = Super, + serverPid = ServerPid, + transportFactory = TF, + protocolFactory = PF + }. + +%%% +%%% instance methods +%%% + +accept(This, ListenSocket, GP, Handler) -> + io:format("acceptor started~n",[]), + + ServerPid = oop:get(This, serverPid), + + case catch gen_tcp:accept(ListenSocket) of + {ok, Socket} -> + + ?C0(ServerPid, effectful_new_acceptor), %% cast to create new acceptor + + %% start_new(tSocket, []) + Client = oop:start_new(tSocket, []), + ?R1(Client, effectful_setHandle, Socket), %% TODO(cpiro): should we just let this be a param to the constructor? + + %% cpiro: OPAQUE!! Trans = Client + TF = oop:get(This, transportFactory), + Trans = ?F1(TF, getTransport, Client), + + %% cpiro: OPAQUE!! Prot = start_new(tBinaryProtocol, [Trans]) + PF = oop:get(This, protocolFactory), + Prot = ?F1(PF, getProtocol, Trans), + + %% start_new(, ...) + Processor = oop:start_new(tErlProcessor, [GP, Handler]), %% TODO + + receive_loop(This, Processor, Prot, Prot), + + exit(acceptor_done); %% TODO(cpiro): grace? + + Else -> + R = lists:flatten( + io_lib:format("accept() failed: ~p", [Else])), + + exit(tTransportException:new(R)) + end. + +receive_loop(This, Processor, Iprot, Oprot) -> + case catch ?R2(Processor, process, Iprot, Oprot) of + {'EXIT', X} -> + io:format("Acceptor: we gotta ~p~n", [X]); + + Value -> + io:format("request processed: rv=~p~n", [Value]), + receive_loop(This, Processor, Iprot, Oprot) + end. + +%%% +%%% error handlers +%%% + +%% end + +%%% old codez + +%% effectful_listen(This) -> %% +%% Port = oop:get(This, port), %% +%% Options = [binary, {packet, 0}, {active, false}], % was [] %% +%% %% +%% case gen_tcp:listen(Port, Options) of %% +%% {ok, ListenSocket} -> %% +%% This1 = oop:set(This, handle, ListenSocket), %% +%% {ok, This1} %% +%% %% +%% % {error, _} -> %% +%% % TODO: no error handling in Ruby version? %% +%% end. %% +%% %% +%% accept(This) -> %% +%% case oop:get(This, handle) of %% +%% nil -> %% +%% nil; % cpiro: sic the Ruby code %% +%% %% +%% Handle -> %% +%% case gen_tcp:accept(Handle) of %% +%% {ok, Sock} -> %% +%% Trans = oop:start_new(tSocket, []), %% +%% ?R1(Trans, effectful_setHandle, Sock), %% +%% Trans %% +%% % {error, _} -> %% +%% % TODO: no error handling in Ruby version? %% +%% end %% +%% end. %% +%% %% +%% effectful_close(This) -> %% +%% case oop:get(This, handle) of %% +%% nil -> %% +%% {nil, This}; %% +%% Handle -> %% +%% case gen_tcp:close(Handle) of %% +%% ok -> %% +%% {ok, This} % cpiro: sic the Ruby version: don't set handle to nil %% +%% % {error, _} -> %% +%% % TODO: no error handling in Ruby version? %% +%% end %% +%% end. %% + + +%%% teh iservez + +%% -module(iserve_socket). %% +%% %% +%% -export([start_link/3]). %% +%% %% +%% -export([init/1]). %% +%% -include("iserve.hrl"). %% +%% %% +%% %TEST %% +%% -export([handle_get/2]). %% +%% %% +%% -define(not_implemented_501, "HTTP/1.1 501 Not Implemented\r\n\r\n"). %% +%% -define(forbidden_403, "HTTP/1.1 403 Forbidden\r\n\r\n"). %% +%% -define(not_found_404, "HTTP/1.1 404 Not Found\r\n\r\n"). %% +%% %% +%% -record(c, {sock, %% +%% port, %% +%% peer_addr, %% +%% peer_port %% +%% }). %% +%% %% +%% -define(server_idle_timeout, 30*1000). %% +%% %% +%% start_link(ListenPid, ListenSocket, ListenPort) -> %% +%% proc_lib:spawn_link(?MODULE, init, [{ListenPid, ListenSocket, ListenPort}]). %% +%% %% + + +%% init({Listen_pid, Listen_socket, ListenPort}) -> %% +%% % error_logger:info_msg("Socket Started~n"), %% +%% case catch gen_tcp:accept(Listen_socket) of %% +%% {ok, Socket} -> %% +%% %% Send the cast message to the listener process to create a new acceptor %% +%% iserve_server:create(Listen_pid, self()), %% +%% {ok, {Addr, Port}} = inet:peername(Socket), %% +%% Conn = #c{sock = Socket, %% +%% port = ListenPort, %% +%% peer_addr = Addr, %% +%% peer_port = Port}, %% +%% request(Conn, #req{}); %% Jump to state 'request' %% +%% Else -> %% +%% error_logger:error_report([{application, iserve}, %% +%% "Accept failed error", %% +%% io_lib:format("~p",[Else])]), %% +%% exit({error, accept_failed}) %% +%% end. %% +%% %% + +%% request(Conn, Req) -> %% +%% case gen_tcp:recv(Conn#c.sock, 0, ?server_idle_timeout) of %% +%% {ok, {http_request,Method,Path,Version}} -> %% +%% headers(Conn, Req#req{vsn = Version, %% +%% method = Method, %% +%% uri = Path}, []); %% +%% {error, {http_error, "\r\n"}} -> %% +%% request(Conn, Req); %% +%% {error, {http_error, "\n"}} -> %% +%% request(Conn, Req); %% +%% {tcp_closed, _Port} -> %% +%% error_logger:info_msg("Closed connection: ~p ~p~n", [Conn#c.peer_addr, Conn#c.peer_port]), %% +%% exit(normal); %% +%% _Other -> %% +%% exit(normal) %% +%% end. %% + diff --git a/lib/erl/lib/thrift/src/transport/tServerSocket.erl b/lib/erl/lib/thrift/src/transport/tServerSocket.erl new file mode 100644 index 00000000..d0cbf92c --- /dev/null +++ b/lib/erl/lib/thrift/src/transport/tServerSocket.erl @@ -0,0 +1,96 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(tServerSocket). + +-include("oop.hrl"). +-include("thrift.hrl"). +-include("transport/tServerSocket.hrl"). + +-behavior(oop). + +-export([attr/4, super/0, inspect/1]). + +-export([new/1, effectful_listen/1, accept/1, effectful_close/1]). + +%%% +%%% define attributes +%%% 'super' is required unless ?MODULE is a base class +%%% + +?DEFINE_ATTR(super); +?DEFINE_ATTR(port); +?DEFINE_ATTR(handle). + +%%% +%%% behavior callbacks +%%% + +%%% super() -> SuperModule = atom() +%%% | none + +super() -> + tServerTransport. + +%%% inspect(This) -> string() + +inspect(This) -> + ?FORMAT_ATTR(port) ++ ", " ++ + ?FORMAT_ATTR(handle). + +%%% +%%% class methods +%%% + +new(Port) -> + Super = (super()):new(), + #?MODULE{super = Super, port = Port, handle = nil}. + +%%% +%%% instance methods +%%% + +effectful_listen(This) -> + Port = oop:get(This, port), + Options = [binary, {packet, 0}, {active, false}], % was [] + + case gen_tcp:listen(Port, Options) of + {ok, ListenSocket} -> + This1 = oop:set(This, handle, ListenSocket), + {ok, This1} + + % {error, _} -> + % TODO: no error handling in Ruby version? + end. + +accept(This) -> + case oop:get(This, handle) of + nil -> + nil; % cpiro: sic the Ruby code + + Handle -> + case gen_tcp:accept(Handle) of + {ok, Sock} -> + Trans = oop:start_new(tSocket, []), + ?R1(Trans, effectful_setHandle, Sock), + Trans + % {error, _} -> + % TODO: no error handling in Ruby version? + end + end. + +effectful_close(This) -> + case oop:get(This, handle) of + nil -> + {nil, This}; + Handle -> + case gen_tcp:close(Handle) of + ok -> + {ok, This} % cpiro: sic the Ruby version: don't set handle to nil + % {error, _} -> + % TODO: no error handling in Ruby version? + end + end. diff --git a/lib/erl/lib/thrift/src/transport/tServerTransport.erl b/lib/erl/lib/thrift/src/transport/tServerTransport.erl new file mode 100644 index 00000000..dfc9ccbe --- /dev/null +++ b/lib/erl/lib/thrift/src/transport/tServerTransport.erl @@ -0,0 +1,52 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(tServerTransport). + +-include("oop.hrl"). +-include("transport/tServerTransport.hrl"). + +-behavior(oop). + +-export([attr/4, super/0, inspect/1]). + +-export([new/0]). + +%%% +%%% define attributes +%%% 'super' is required unless ?MODULE is a base class +%%% + +?ATTR_DUMMY. + +%%% +%%% behavior callbacks +%%% + +%%% super() -> SuperModule = atom() +%%% | none + +super() -> + none. + +%%% inspect(This) -> string() + +inspect(_This) -> + "". + +%%% +%%% class methods +%%% + +new() -> + #?MODULE{}. + +%%% +%%% instance methods +%%% + +getTransport(_This, Trans) -> + Trans. diff --git a/lib/erl/lib/thrift/src/transport/tSocket.erl b/lib/erl/lib/thrift/src/transport/tSocket.erl new file mode 100644 index 00000000..3ac066c6 --- /dev/null +++ b/lib/erl/lib/thrift/src/transport/tSocket.erl @@ -0,0 +1,126 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(tSocket). + +-include("oop.hrl"). + +-include("thrift.hrl"). +-include("transport/tTransportException.hrl"). +% -include("transport/tTransport.hrl"). +-include("transport/tSocket.hrl"). + +-behavior(oop). + +-export([attr/4, super/0, inspect/1]). + +-export([new/0, new/1, new/2, + effectful_setHandle/2, effectful_open/1, + isOpen/1, write/2, read/2, effectful_close/1]). + +%%% +%%% define attributes +%%% 'super' is required unless ?MODULE is a base class +%%% + +?DEFINE_ATTR(super); +?DEFINE_ATTR(host); +?DEFINE_ATTR(port); +?DEFINE_ATTR(handle). + +%%% +%%% behavior callbacks +%%% + +%%% super() -> SuperModule = atom() +%%% | none + +super() -> + tTransport. + +%%% inspect(This) -> string() + +inspect(This) -> + ?FORMAT_ATTR(host) ++ ", " ++ + ?FORMAT_ATTR(port) ++ ", " ++ + ?FORMAT_ATTR(handle). + +%%% +%%% class methods +%%% + +new(Host, Port) -> + Super = (super()):new(), + #?MODULE{super=Super, host=Host, port=Port, handle=nil}. + +new(Host) -> + new(Host, 9090). + +new() -> + new("localhost", 9090). + +%%% +%%% instance methods +%%% + +effectful_setHandle(This, Handle) -> + {ok, oop:set(This, handle, Handle)}. + +effectful_open(This) -> + Host = oop:get(This, host), + Port = oop:get(This, port), + Options = [], + + case gen_tcp:connect(Host, Port, Options) of + {error, _} -> + exit(tTransportException:new( + ?tTransportException_NOT_OPEN, + "Could not connect to " ++ Host ++ ":" ++ Port) + ); + {ok, Socket} -> + {ok, oop:set(This, handle, Socket)} + end. + +isOpen(This) -> + oop:get(This, handle) /= nil. + +write(This, Str) -> + Handle = oop:get(This, handle), + Val = gen_tcp:send(Handle, Str), + + %% io:format("WRITE |~p|(~p)~n", [Str,Val]), + + case Val of + {error, _} -> + throw(tTransportException:new(?tTransportException_NOT_OPEN, "in write")); + ok -> + ok + end. + +read(This, Sz) -> + Handle = oop:get(This, handle), + case gen_tcp:recv(Handle, Sz) of + {ok, []} -> + Host = oop:get(This, host), + Port = oop:get(This, port), + throw(tTransportException:new(?tTransportException_UNKNOWN, "TSocket: Could not read " ++ Sz ++ "bytes from " ++ Host ++ ":" ++ Port)); + {ok, Data} -> + Data; + {error, Error} -> + io:format("in tSocket:read/2: gen_tcp:recv(~p, ~p) => {error, ~p}~n", + [Handle, Sz, Error]), + exit(tTransportException:new(?tTransportException_NOT_OPEN, "in tSocket:read/2: gen_tcp:recv")) + end. + +effectful_close(This) -> + case oop:get(This, handle) of + nil -> + {ok, This}; + Handle -> + gen_tcp:close(Handle), + {ok, oop:set(This, handle, nil)} + end. + diff --git a/lib/erl/lib/thrift/src/transport/tTransport.erl b/lib/erl/lib/thrift/src/transport/tTransport.erl new file mode 100644 index 00000000..c15a632d --- /dev/null +++ b/lib/erl/lib/thrift/src/transport/tTransport.erl @@ -0,0 +1,86 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(tTransport). + +-include("oop.hrl"). + +-include("thrift.hrl"). +-include("transport/tTransport.hrl"). + +-behavior(oop). + +-export([attr/4, super/0, inspect/1]). + +-export([new/0, isOpen/1, open/1, close/1, read/2, readAll/2, effectful_write/2, effectful_flush/1]). + +%%% +%%% define attributes +%%% 'super' is required unless ?MODULE is a base class +%%% + +?ATTR_DUMMY. + +%%% +%%% behavior callbacks +%%% + +%%% super() -> SuperModule = atom() +%%% | none + +super() -> + none. + +%%% inspect(This) -> string() + +inspect(_This) -> + "". + +%%% +%%% class methods +%%% + +new() -> + #?MODULE{}. + +%%% +%%% instance methods +%%% + + + +isOpen(_This) -> nil. +open(_This) -> nil. +close(_This) -> nil. +read(_This, _Sz) -> nil. + +readAll(This, Sz) -> + readAll_loop(This, Sz, "", 0). + +readAll_loop(This, Sz, Buff, Have) -> + if + Have < Sz -> + Chunk = ?L1(read, Sz - Have), + + %% man gen_tcp: + %% exactly Length bytes are returned, or an error; + %% possibly discarding less than Length bytes of data when + %% the socket gets closed from the other side. + + %% io:format("READ |~p|~n", [Chunk]), + + Have1 = Have + (Sz-Have), % length(Chunk) + Buff1 = Buff ++ Chunk, % TODO: ++ efficiency? + readAll_loop(This, Sz, Buff1, Have1); + true -> + Buff + end. + +effectful_write(This, _Buf) -> + {nil, This}. + +effectful_flush(This) -> + {nil, This}. diff --git a/lib/erl/lib/thrift/src/transport/tTransportException.erl b/lib/erl/lib/thrift/src/transport/tTransportException.erl new file mode 100644 index 00000000..43a7afac --- /dev/null +++ b/lib/erl/lib/thrift/src/transport/tTransportException.erl @@ -0,0 +1,58 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(tTransportException). + +-include("oop.hrl"). + +-include("thrift.hrl"). +-include("transport/tTransportException.hrl"). + +-behavior(oop). + +-export([attr/4, super/0, inspect/1]). + +-export([new/0, new/1, new/2]). + +%%% +%%% define attributes +%%% 'super' is required unless ?MODULE is a base class +%%% + +?DEFINE_ATTR(super); +?DEFINE_ATTR(type). + +%%% +%%% behavior callbacks +%%% + +%%% super() -> SuperModule = atom() +%%% | none + +super() -> + tException. + +%%% inspect(This) -> string() + +inspect(This) -> + ?FORMAT_ATTR(type). + +%%% +%%% class methods +%%% + +new(Type, Message) -> + Super = (super()):new(Message), + #?MODULE{super=Super, type=Type}. + +new() -> + new(?tTransportException_UNKNOWN, undefined). +new(Type) -> + new(Type, undefined). + +%%% +%%% instance methods +%%% diff --git a/lib/erl/lib/thrift/src/transport/tTransportFactory.erl b/lib/erl/lib/thrift/src/transport/tTransportFactory.erl new file mode 100644 index 00000000..1c8ca614 --- /dev/null +++ b/lib/erl/lib/thrift/src/transport/tTransportFactory.erl @@ -0,0 +1,52 @@ +%%% Copyright (c) 2007- Facebook +%%% Distributed under the Thrift Software License +%%% +%%% See accompanying file LICENSE or visit the Thrift site at: +%%% http://developers.facebook.com/thrift/ + +-module(tTransportFactory). + +-include("oop.hrl"). +-include("transport/tTransportFactory.hrl"). + +-behavior(oop). + +-export([attr/4, super/0, inspect/1]). + +-export([new/0, getTransport/2]). + +%%% +%%% define attributes +%%% 'super' is required unless ?MODULE is a base class +%%% + +?ATTR_DUMMY. + +%%% +%%% behavior callbacks +%%% + +%%% super() -> SuperModule = atom() +%%% | none + +super() -> + none. + +%%% inspect(This) -> string() + +inspect(_This) -> + "". + +%%% +%%% class methods +%%% + +new() -> + #?MODULE{}. + +%%% +%%% instance methods +%%% + +getTransport(_This, Trans) -> + Trans. diff --git a/lib/erl/lib/thrift/tutorial b/lib/erl/lib/thrift/tutorial new file mode 120000 index 00000000..9720a4c4 --- /dev/null +++ b/lib/erl/lib/thrift/tutorial @@ -0,0 +1 @@ +../../../../tutorial \ No newline at end of file diff --git a/lib/erl/lib/thrift/user b/lib/erl/lib/thrift/user new file mode 120000 index 00000000..a5aac6eb --- /dev/null +++ b/lib/erl/lib/thrift/user @@ -0,0 +1 @@ +../../../../tutorial/erl \ No newline at end of file diff --git a/lib/erl/lib/thrift/vsn.mk b/lib/erl/lib/thrift/vsn.mk new file mode 100644 index 00000000..d9b40014 --- /dev/null +++ b/lib/erl/lib/thrift/vsn.mk @@ -0,0 +1 @@ +THRIFT_VSN=0.1 diff --git a/lib/erl/licence.txt b/lib/erl/licence.txt new file mode 100644 index 00000000..8ee29920 --- /dev/null +++ b/lib/erl/licence.txt @@ -0,0 +1,20 @@ +Tue Oct 24 12:28:44 CDT 2006 + +Copyright (c) <2006> + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software (OTP Base, fslib, G.A.S) and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies +of the Software, and to permit persons to whom the Software is furnished to do +so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, +INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A +PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE +OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/lib/erl/release_DISABLED/Makefile b/lib/erl/release_DISABLED/Makefile new file mode 100644 index 00000000..c3274cd3 --- /dev/null +++ b/lib/erl/release_DISABLED/Makefile @@ -0,0 +1,10 @@ +include ../build/colors.mk + +MODULES=$(shell ls . | grep "[^(Makefile)]") + +all clean: + @for dir in $(MODULES); do \ + (cd $$dir; if [ -e "SKIP" ]; then echo $${MY_LRED:-$(LRED)}"skipping \"make $@\" for $$dir"; else ${MAKE} $@; fi); \ + if [ "$$?" -ne "0" ]; then ERROR=$$?; echo "Error Code $$ERROR"; exit $$ERROR; fi; \ + echo -n $(OFF)$(NO_COLOR); \ + done diff --git a/lib/erl/release_DISABLED/thrift_rel/Makefile b/lib/erl/release_DISABLED/thrift_rel/Makefile new file mode 100755 index 00000000..5d35956a --- /dev/null +++ b/lib/erl/release_DISABLED/thrift_rel/Makefile @@ -0,0 +1,298 @@ +# ---------------------------------------------------- +# Make file for creating an otp release. +# ---------------------------------------------------- + +## +# Basename of this release. +## +RELS=$(shell basename `pwd`) +APP_NAME=$(shell echo $(RELS) | sed s/_rel$$//) + +include ../../build/otp.mk + +include ./vsn.mk + +#include $(ERL_TOP)/make/target.mk +#include $(ERL_TOP)/make/$(TARGET)/otp.mk + +USR_LIBPATH=../../lib +INSTALL_DIR=/usr/local/lib +ABS_USER_LIBPATH=$(shell cd ../../lib;pwd) + +# ---------------------------------------------------- +# CREATE DIR STRUCTURE HERE +# ---------------------------------------------------- + +HTDOCS=$(wildcard $(ABS_USER_LIBPATH)/$(APP_NAME)/htdocs/*.html) \ + $(wildcard $(ABS_USER_LIBPATH)/$(APP_NAME)/htdocs/*.htm) \ + $(wildcard $(ABS_USER_LIBPATH)/$(APP_NAME)/htdocs/*.yaws) +BUILD_FILES=fs_boot_smithe.beam fs_lists.beam fs_lib.beam + +LOCAL_DIR=local +#LOCAL_DIR=$(shell cat $(RELS).rel.src |grep -m 1 '$(APP_NAME)' |awk -F '"' '{printf "%s-%s", $$2,$$4}') + +DIR_STRUCTURE= \ + $(LOCAL_DIR) \ + $(LOCAL_DIR)/log/$(REL_VSN) \ + $(LOCAL_DIR)/var/$(REL_VSN) \ + $(LOCAL_DIR)/var/$(REL_VSN)/www/conf \ + $(LOCAL_DIR)/var/$(REL_VSN)/www/htdocs + +PRODUCTION_DIR_STRUCTURE= \ + $(RELS) \ + $(RELS)/release/$(REL_VSN) \ + $(RELS)/stage \ + $(RELS)/log/$(REL_VSN) \ + $(RELS)/var/$(REL_VSN) \ + $(RELS)/var/$(REL_VSN)/www \ + $(RELS)/var/$(REL_VSN)/www/htdocs \ + $(RELS)/var/$(REL_VSN)/www/conf + +# ---------------------------------------------------- +SCRIPT_AND_BOOT_FILES= \ + $(RELS).script \ + $(RELS).boot + +LOCAL_SCRIPT_AND_BOOT_FILES= \ + $(LOCAL_DIR)/$(RELS).script \ + $(LOCAL_DIR)/$(RELS).boot + +LOCAL_HTTP_CONF= \ + $(LOCAL_DIR)/var/$(REL_VSN)/www/conf/yaws.conf \ + $(LOCAL_DIR)/var/$(REL_VSN)/www/conf/mime.types + +PRODUCTION_HTTP_CONF= \ + $(LOCAL_DIR)/var/$(REL_VSN)/www/conf/yaws.conf \ + $(LOCAL_DIR)/var/$(REL_VSN)/www/conf/mime.types + +LOCAL_TARGET_FILES=$(LOCAL_HTTP_CONF) $(LOCAL_DIR)/$(RELS).config $(LOCAL_SCRIPT_AND_BOOT_FILES) + +LOCAL_TARGETS=$(LOCAL_DIR)/$(RELS).sh vsnit $(LOCAL_TARGET_FILES) + +PRODUCTION_TARGETS=$(RELS)/build/$(REL_VSN) \ + $(RELS)/lib \ + $(RELS)/stage/$(RELS).rel.src \ + $(RELS)/stage/$(RELS).config.src \ + $(RELS)/stage/yaws.conf.src \ + $(RELS)/stage/$(RELS).sh.src \ + $(RELS)/var/$(REL_VSN)/www/htdocs \ + $(RELS)/install.sh \ + $(RELS)/release/$(REL_VSN)/clean_release + +# ---------------------------------------------------- +# TARGETS +# ---------------------------------------------------- + +all debug opt instr script: $(DIR_STRUCTURE) $(LOCAL_TARGETS) $(PRODUCTION_DIR_STRUCTURE) $(PRODUCTION_TARGETS) + @echo $(HTDOCS) + +install: stage + +tar: $(RELS)-$(LOCATION)-$(REL_VSN).tgz + +$(DIR_STRUCTURE): + mkdir -p $@ + +$(PRODUCTION_DIR_STRUCTURE): + mkdir -p $@ + +clean: + $(RM) $(REL_SCRIPTS) $(TARGET_FILES) + $(RM) -r $(LOCAL_DIR) $(PRODN_DIR) + $(RM) $(RELS).rel + $(RM) -r $(RELS) + $(RM) $(RELS)*.tgz + $(RM) $(RELS).rel.src.tmp + $(RM) $(SCRIPT_AND_BOOT_FILES) + +docs: + +# ---------------------------------------------------- +# TARGETS FOR LOCAL MODE +# ---------------------------------------------------- + +# startup script for local mode +$(LOCAL_DIR)/$(RELS).sh: + @echo '#!/bin/sh' > $@ + @echo "cd $(CURDIR)/$(LOCAL_DIR)" >> $@ + @echo "erl -name $${USER}_$(RELS) -boot $(RELS) -config $(RELS).config \$$@" >> $@ + chmod +x $@ + @echo + @echo "==== Start local node with \"sh $@\" ====" + @echo + +# Create the config file for local mode. +$(LOCAL_DIR)/$(RELS).config: $(RELS).config.src + sed -e 's;%LOG_OTP%;$(CURDIR)/$(LOCAL_DIR)/log/$(REL_VSN);' \ + -e 's;%VAR_OTP%;$(CURDIR)/$(LOCAL_DIR)/var/$(REL_VSN);' \ + -e 's;%RELS%;$(RELS);g' \ + -e 's;%HOME%;$(HOME);g' \ + -e 's;%BROADCAST_ADDRESS%;$(BROADCAST_ADDRESS);g' \ + -e 's;%CONTACT_NODE%;$(CONTACT_NODE);g' \ + -e "s;%HOSTNAME%;`hostname --long`;" \ + -e 's;%APP_NAME%;$(APP_NAME);' \ + -e 's;%APP_VERSION%;$(APP_VERSION);g' \ + $< > $@ + +# Create the httpd conf file for local mode. +$(LOCAL_DIR)/var/$(REL_VSN)/www/conf/yaws.conf: yaws.conf.src + sed -e 's;%VAR_OTP%;$(CURDIR)/$(LOCAL_DIR)/var/$(REL_VSN);' \ + -e 's;%LOG_OTP%;$(CURDIR)/$(LOCAL_DIR)/log/$(REL_VSN);' \ + -e 's;%HTDOC_ROOT%;$(ABS_USER_LIBPATH)/$(APP_NAME)/htdocs;' \ + -e 's;%APP_NAME%;$(APP_NAME);' \ + -e 's;%RELS%;$(RELS);' \ + -e 's;%USER%;$(USER);' \ + -e 's;%HTDOC_ROOT%;$(ABS_USER_LIBPATH);' \ + -e 's;%MHOST%;$(MHOST);' \ + $< > $@ + +# Create the config file for local mode. +vsnit: $(RELS).rel.src + sed -e 's;%REL_VSN%;$(REL_VSN);' \ + $< > $<.tmp + +# Create and position script and boot files for local mode. +$(LOCAL_SCRIPT_AND_BOOT_FILES): + @ erl -pz $(USR_LIBPATH)/fslib/ebin \ + -noshell \ + -s fs_lib s_apply fs_boot_smithe make_script_and_boot "[\"$(ERL_RUN_TOP)/*\", \"$(USR_LIBPATH)\"]. " \ + \"$$(basename `pwd`)".rel.src.tmp\". " \ + "[local]. " \ + -s init stop + cp $(SCRIPT_AND_BOOT_FILES) $(LOCAL_DIR)/ + +$(LOCAL_DIR)/var/$(REL_VSN)/www/conf/mime.types: ../../build/mime.types + cp $< $@ + +# ---------------------------------------------------- +# TARGETS FOR PRODUCTION MODE +# ---------------------------------------------------- +$(RELS)/lib: + # For some reason this will not happen if added to PRODUCTION_DIR_STRUCTURE + mkdir $@ + @ erl -pz $(RELS)/build/$(REL_VSN) \ + -noshell \ + -s fs_lib s_apply fs_boot_smithe stage_from_relsrc "[\"$(USR_LIBPATH)\"]. " \ + \"$$(basename `pwd`)".rel.src\". " \ + \"$@\"". " \ + -s init stop + +# Move the htdocs from the local apps to the production htdoc root directory. +$(RELS)/var/$(REL_VSN)/www/htdocs/: $(HTDOCS) + @mkdir -p $(RELS)/var/$(REL_VSN)/www/htdocs; \ + for x in $(HTDOCS);do \ + cp $$x $@; \ + done + +# startup script for production mode +$(RELS)/stage/$(RELS).sh.src: + @echo '#!/bin/sh' > $@ + @echo "cd %INSTALL_DIR%/$(RELS)/release/$(REL_VSN)" >> $@ + @echo "erl -name $(RELS) -boot $(RELS) -config $(RELS).config -detached \$$@" >> $@ + chmod +x $@ + +$(RELS)/build/$(REL_VSN): $(USR_LIBPATH)/fslib/ebin + mkdir -p $(RELS)/build/$(REL_VSN) + cp $ $@ + @echo "" >> $@ + @echo "if [ \$$# -eq 1 ];then" >> $@ + @echo " INSTALL_DIR=\$$1;" >> $@ + @echo "else" >> $@ + @echo " INSTALL_DIR=$(INSTALL_DIR);" >> $@ + @echo "fi" >> $@ + @echo "" >> $@ + @echo "function munge() {" >> $@ + @echo " sed -e \"s;%LOG_OTP%;\$$INSTALL_DIR/$(RELS)/log/$(REL_VSN);g\" \\" >> $@ + @echo " -e \"s;%VAR_OTP%;\$$INSTALL_DIR/$(RELS)/var/$(REL_VSN);g\" \\" >> $@ + @echo " -e \"s;%RELS%;$(RELS);g\" \\" >> $@ + @echo " -e \"s;%REL_VSN%;$(REL_VSN);g\" \\" >> $@ + @echo " -e \"s;%USER%;$$USER;g\" \\" >> $@ + @echo " -e \"s;%HTDOC_ROOT%;\$$INSTALL_DIR/$(RELS)/var/$(REL_VSN)/www/htdocs;g\" \\" >> $@ + @echo " -e \"s;%MHOST%;\`hostname\`;g\" \\" >> $@ + @echo " -e \"s;%BROADCAST_ADDRESS%;$(BROADCAST_ADDRESS);g\" \\" >> $@ + @echo " -e \"s;%INSTALL_DIR%;\$$INSTALL_DIR;g\" \\" >> $@ + @echo " -e \"s;%CONTACT_NODE%;$(CONTACT_NODE);g\" \\" >> $@ + @echo " -e \"s;%HOSTNAME%;\`hostname --long\`;g\" \\" >> $@ + @echo " -e \"s;%APP_NAME%;$(APP_NAME);g\" \\" >> $@ + @echo " -e \"s;%APP_VERSION%;$(APP_VERSION);g\" \\" >> $@ + @echo ' $$1 > $$2' >> $@ + @echo "}" >> $@ + @echo "" >> $@ + @echo "munge stage/yaws.conf.src var/$(REL_VSN)/www/conf/yaws.conf;" >> $@ + @echo "munge stage/$(RELS).config.src release/$(REL_VSN)/$(RELS).config;" >> $@ + @echo "munge stage/$(RELS).sh.src release/$(REL_VSN)/$(RELS).sh;" >> $@ + @echo "munge stage/$(RELS).rel.src release/$(REL_VSN)/$(RELS).rel;" >> $@ + @echo "chmod +x release/$(REL_VSN)/$(RELS).sh;" >> $@ + @echo "" >> $@ + @echo "cd ..;" >> $@ + @echo "find $(RELS) | cpio -o > \$$INSTALL_DIR/$(RELS).cpio;" >> $@ + @echo "cd -;" >> $@ + @echo "cd \$$INSTALL_DIR; " >> $@ + @echo "echo -n \"Unpacked: \"" >> $@ + @echo "cpio -uid < $(RELS).cpio;" >> $@ + @echo "rm $(RELS).cpio;" >> $@ + @echo "" >> $@ + @echo "echo \"pwd is \`pwd\`\";" >> $@ + @echo "cd $(RELS);" >> $@ + @echo " erl -pz build/$(REL_VSN) \\" >> $@ + @echo " -noshell \\" >> $@ + @echo -n " -s fs_lib s_apply fs_boot_smithe make_script_and_boot \"[\\\"$(ERL_RUN_TOP)/*\\\", \\\"lib/\\\"]. \" " >> $@ + @echo -n "\"\\\"stage/$$(basename `pwd`).rel.src\\\". \" " >> $@ + @echo -n "\"[local]. \" " >> $@ + @echo "-s init stop | egrep '*terminate*|ERROR'" >> $@ + @echo "if [ \$$? -eq 0 ]; then" >> $@ + @echo "echo \"============================================\";" >> $@ + @echo "echo \"STAGE FAILURE \$$? - Silence the discord.\";" >> $@ + @echo "echo \"============================================\";" >> $@ + @echo "exit 1;" >> $@ + @echo "fi" >> $@ + @echo "" >> $@ + @echo "mv $(RELS).rel $(RELS).script $(RELS).boot release/$(REL_VSN);" >> $@ + @echo "" >> $@ + @echo "rm -r stage;" >> $@ + @echo "rm -r build;" >> $@ + @echo "cd -;" >> $@ + @echo "" >> $@ + @echo "chgrp -R erts $(RELS); " >> $@ + @echo "chmod -R 775 $(RELS); " >> $@ + @echo "cd -" >> $@ + @echo "" >> $@ + @echo "rm -f /usr/local/bin/$(APP_NAME);" >> $@ + @echo "ln -s \$$INSTALL_DIR/$(RELS)/release/$(REL_VSN)/$(RELS).sh /usr/local/bin/$(APP_NAME);" >> $@ + @echo "chgrp -R erts /usr/local/bin/$(APP_NAME); " >> $@ + @echo "chmod -R 775 /usr/local/bin/$(APP_NAME); " >> $@ + @echo "rm \$$INSTALL_DIR/$(RELS)/install.sh;" >> $@ + @echo "echo -n $$'\e[0;32m'" >> $@ + @echo "echo \"$(APP_NAME) installation to \$$INSTALL_DIR complete.\"" >> $@ + @echo "echo -n $$'\e[0m'" >> $@ + chmod +x $@ + + +stage: $(RELS) + cd $(RELS); \ + ./install.sh; \ + cd - + +$(RELS)/var/$(REL_VSN)/www/conf/mime.types: ../../build/mime.types + cp $< $@ + +$(RELS)-$(LOCATION)-$(REL_VSN).tgz: $(RELS) + tar -zcvf $@ $< + +$(RELS)/release/$(REL_VSN)/clean_release: ../../tools/utilities/clean_release + cp $< $@ + diff --git a/lib/erl/release_DISABLED/thrift_rel/local/thrift_rel.config b/lib/erl/release_DISABLED/thrift_rel/local/thrift_rel.config new file mode 100644 index 00000000..39091efd --- /dev/null +++ b/lib/erl/release_DISABLED/thrift_rel/local/thrift_rel.config @@ -0,0 +1,26 @@ +%%% -*- mode:erlang -*- +%%% Parameter settings for apps on thrift +%%% Warning - this config file *must* end with + +%% write log files to sasl_dir +[ + {sasl, + [ + {sasl_error_logger, {file, "/data/users/cpiro/thrift/trunk/lib/erl/release/thrift_rel/local/log/1.0/sasl_log"}} + ]}, + + + {gas, + [ + {mod_specs, [{elwrap, {fs_elwrap_h, start_link}}]}, + + % elwrap config. + {err_log, "/data/users/cpiro/thrift/trunk/lib/erl/release/thrift_rel/local/log/1.0/err_log"}, + {err_log_wrap_info, {{err,5000000,10},{sasl,5000000,10}}}, + {err_log_tty, true} % Log to the screen + ]}, + + {thrift, + [ + ]} +]. diff --git a/lib/erl/release_DISABLED/thrift_rel/local/thrift_rel.sh b/lib/erl/release_DISABLED/thrift_rel/local/thrift_rel.sh new file mode 100755 index 00000000..d30a43c0 --- /dev/null +++ b/lib/erl/release_DISABLED/thrift_rel/local/thrift_rel.sh @@ -0,0 +1,3 @@ +#!/bin/sh +cd /data/users/cpiro/thrift/trunk/lib/erl/release/thrift_rel/local +erl -name cpiro_thrift_rel -boot thrift_rel -config thrift_rel.config $@ diff --git a/lib/erl/release_DISABLED/thrift_rel/local/var/1.0/www/conf/mime.types b/lib/erl/release_DISABLED/thrift_rel/local/var/1.0/www/conf/mime.types new file mode 100644 index 00000000..d6e3c0d0 --- /dev/null +++ b/lib/erl/release_DISABLED/thrift_rel/local/var/1.0/www/conf/mime.types @@ -0,0 +1,98 @@ + +application/activemessage +application/andrew-inset +application/applefile +application/atomicmail +application/dca-rft +application/dec-dx +application/mac-binhex40 hqx +application/mac-compactpro cpt +application/macwriteii +application/msword doc +application/news-message-id +application/news-transmission +application/octet-stream bin dms lha lzh exe class +application/oda oda +application/pdf pdf +application/postscript ai eps ps +application/powerpoint ppt +application/remote-printing +application/rtf rtf +application/slate +application/wita +application/wordperfect5.1 +application/x-bcpio bcpio +application/x-cdlink vcd +application/x-compress Z +application/x-cpio cpio +application/x-csh csh +application/x-director dcr dir dxr +application/x-dvi dvi +application/x-gtar gtar +application/x-gzip gz +application/x-hdf hdf +application/x-httpd-cgi cgi +application/x-koan skp skd skt skm +application/x-latex latex +application/x-mif mif +application/x-netcdf nc cdf +application/x-sh sh +application/x-shar shar +application/x-stuffit sit +application/x-sv4cpio sv4cpio +application/x-sv4crc sv4crc +application/x-tar tar +application/x-tcl tcl +application/x-tex tex +application/x-texinfo texinfo texi +application/x-troff t tr roff +application/x-troff-man man +application/x-troff-me me +application/x-troff-ms ms +application/x-ustar ustar +application/x-wais-source src +application/zip zip +audio/basic au snd +audio/mpeg mpga mp2 +audio/x-aiff aif aiff aifc +audio/x-pn-realaudio ram +audio/x-pn-realaudio-plugin rpm +audio/x-realaudio ra +audio/x-wav wav +chemical/x-pdb pdb xyz +image/gif gif +image/ief ief +image/jpeg jpeg jpg jpe +image/png png +image/tiff tiff tif +image/x-cmu-raster ras +image/x-portable-anymap pnm +image/x-portable-bitmap pbm +image/x-portable-graymap pgm +image/x-portable-pixmap ppm +image/x-rgb rgb +image/x-xbitmap xbm +image/x-xpixmap xpm +image/x-xwindowdump xwd +message/external-body +message/news +message/partial +message/rfc822 +multipart/alternative +multipart/appledouble +multipart/digest +multipart/mixed +multipart/parallel +text/html html htm +text/x-server-parsed-html shtml +text/plain txt +text/richtext rtx +text/tab-separated-values tsv +text/x-setext etx +text/x-sgml sgml sgm +video/mpeg mpeg mpg mpe +video/quicktime qt mov +video/x-msvideo avi +video/x-sgi-movie movie +x-conference/x-cooltalk ice +x-world/x-vrml wrl vrml diff --git a/lib/erl/release_DISABLED/thrift_rel/local/var/1.0/www/conf/yaws.conf b/lib/erl/release_DISABLED/thrift_rel/local/var/1.0/www/conf/yaws.conf new file mode 100644 index 00000000..8857aac5 --- /dev/null +++ b/lib/erl/release_DISABLED/thrift_rel/local/var/1.0/www/conf/yaws.conf @@ -0,0 +1,166 @@ + +# conf for yaws + + +# first we have a set of globals +# That apply to all virtual servers + + +# This is the directory where all logfiles for +# all virtual servers will be written + +logdir = /var/log/yaws + +# This the path to a directory where additional +# beam code can be placed. The daemon will add this +# directory to its search path + +ebin_dir = /var/yaws/ebin + + +# This is a directory where application specific .hrl +# files can be placed. application specifig .yaws code can +# then include these .hrl files + +include_dir = /var/yaws/include + + + + + +# This is a debug variable, possible values are http | traffic | false +# It is also possible to set the trace (possibly to the tty) while +# invoking yaws from the shell as in +# yaws -i -T -x (see man yaws) + +trace = false + + + + + +# it is possible to have yaws start additional +# application specific code at startup +# +# runmod = mymodule + + +# By default yaws will copy the erlang error_log and +# end write it to a wrap log called report.log (in the logdir) +# this feature can be turned off. This would typically +# be the case when yaws runs within another larger app + +copy_error_log = true + + +# Logs are wrap logs + +log_wrap_size = 1000000 + + +# Possibly resolve all hostnames in logfiles so webalizer +# can produce the nice geography piechart + +log_resolve_hostname = false + + + +# fail completely or not if yaws fails +# to bind a listen socket +fail_on_bind_err = true + + + +# If yaws is started as root, it can, once it has opened +# all relevant sockets for listening, change the uid to a +# user with lower accessrights than root + +# username = nobody + + +# If HTTP auth is used, it is possible to have a specific +# auth log. + +auth_log = true + + +# When we're running multiple yaws systems on the same +# host, we need to give each yaws system an individual +# name. Yaws will write a number of runtime files under +# /tmp/yaws/${id} +# The default value is "default" + + +# id = myname + + +# earlier versions of Yaws picked the first virtual host +# in a list of hosts with the same IP/PORT when the Host: +# header doesn't match any name on any Host +# This is often nice in testing environments but not +# acceptable in real live hosting scenarios + +pick_first_virthost_on_nomatch = true + + +# All unices are broken since it's not possible to bind to +# a privileged port (< 1024) unless uid==0 +# There is a contrib in jungerl which makes it possible by means +# of an external setuid root programm called fdsrv to listen to +# to privileged port. +# If we use this feature, it requires fdsrv to be properly installed. +# Doesn't yet work with SSL. + +use_fdsrv = false + + + + +# end then a set of virtual servers +# First two virthosted servers on the same IP (0.0.0.0) +# in this case, but an explicit IP can be given as well + + + port = 80 + listen = 0.0.0.0 + docroot = /var/yaws/www + arg_rewrite_mod = pwr_arg_rewrite_mod + appmods = + + + + port = 80 + listen = 0.0.0.0 + docroot = /tmp + dir_listings = true + dav = true + + realm = foobar + dir = / + user = foo:bar + user = baz:bar + + + + + +# And then an ssl server + + + port = 443 + docroot = /tmp + listen = 0.0.0.0 + dir_listings = true + + keyfile = /usr/local/yaws/etc/yaws-key.pem + certfile = /usr/local/yaws/etc/yaws-cert.pem + + + + + + + + + + diff --git a/lib/erl/release_DISABLED/thrift_rel/thrift_rel.config.src b/lib/erl/release_DISABLED/thrift_rel/thrift_rel.config.src new file mode 100755 index 00000000..c701c5a6 --- /dev/null +++ b/lib/erl/release_DISABLED/thrift_rel/thrift_rel.config.src @@ -0,0 +1,26 @@ +%%% -*- mode:erlang -*- +%%% Parameter settings for apps on %APP_NAME% +%%% Warning - this config file *must* end with + +%% write log files to sasl_dir +[ + {sasl, + [ + {sasl_error_logger, {file, "%LOG_OTP%/sasl_log"}} + ]}, + + + {gas, + [ + {mod_specs, [{elwrap, {fs_elwrap_h, start_link}}]}, + + % elwrap config. + {err_log, "%LOG_OTP%/err_log"}, + {err_log_wrap_info, {{err,5000000,10},{sasl,5000000,10}}}, + {err_log_tty, true} % Log to the screen + ]}, + + {%APP_NAME%, + [ + ]} +]. diff --git a/lib/erl/release_DISABLED/thrift_rel/thrift_rel.rel.src b/lib/erl/release_DISABLED/thrift_rel/thrift_rel.rel.src new file mode 100644 index 00000000..a11d2405 --- /dev/null +++ b/lib/erl/release_DISABLED/thrift_rel/thrift_rel.rel.src @@ -0,0 +1,14 @@ +%%% -*- mode:erlang -*- +{release, + {"thrift_rel", "%REL_VSN%"}, + erts, + [ + kernel, + stdlib, + sasl, + fslib, + gas, + thrift + ] +}. + diff --git a/lib/erl/release_DISABLED/thrift_rel/thrift_rel.rel.src.tmp b/lib/erl/release_DISABLED/thrift_rel/thrift_rel.rel.src.tmp new file mode 100644 index 00000000..b334f707 --- /dev/null +++ b/lib/erl/release_DISABLED/thrift_rel/thrift_rel.rel.src.tmp @@ -0,0 +1,14 @@ +%%% -*- mode:erlang -*- +{release, + {"thrift_rel", "1.0"}, + erts, + [ + kernel, + stdlib, + sasl, + fslib, + gas, + thrift + ] +}. + diff --git a/lib/erl/release_DISABLED/thrift_rel/vsn.mk b/lib/erl/release_DISABLED/thrift_rel/vsn.mk new file mode 100755 index 00000000..0ac8e073 --- /dev/null +++ b/lib/erl/release_DISABLED/thrift_rel/vsn.mk @@ -0,0 +1 @@ +REL_VSN=1.0 diff --git a/lib/erl/release_DISABLED/thrift_rel/yaws.conf.src b/lib/erl/release_DISABLED/thrift_rel/yaws.conf.src new file mode 100644 index 00000000..8857aac5 --- /dev/null +++ b/lib/erl/release_DISABLED/thrift_rel/yaws.conf.src @@ -0,0 +1,166 @@ + +# conf for yaws + + +# first we have a set of globals +# That apply to all virtual servers + + +# This is the directory where all logfiles for +# all virtual servers will be written + +logdir = /var/log/yaws + +# This the path to a directory where additional +# beam code can be placed. The daemon will add this +# directory to its search path + +ebin_dir = /var/yaws/ebin + + +# This is a directory where application specific .hrl +# files can be placed. application specifig .yaws code can +# then include these .hrl files + +include_dir = /var/yaws/include + + + + + +# This is a debug variable, possible values are http | traffic | false +# It is also possible to set the trace (possibly to the tty) while +# invoking yaws from the shell as in +# yaws -i -T -x (see man yaws) + +trace = false + + + + + +# it is possible to have yaws start additional +# application specific code at startup +# +# runmod = mymodule + + +# By default yaws will copy the erlang error_log and +# end write it to a wrap log called report.log (in the logdir) +# this feature can be turned off. This would typically +# be the case when yaws runs within another larger app + +copy_error_log = true + + +# Logs are wrap logs + +log_wrap_size = 1000000 + + +# Possibly resolve all hostnames in logfiles so webalizer +# can produce the nice geography piechart + +log_resolve_hostname = false + + + +# fail completely or not if yaws fails +# to bind a listen socket +fail_on_bind_err = true + + + +# If yaws is started as root, it can, once it has opened +# all relevant sockets for listening, change the uid to a +# user with lower accessrights than root + +# username = nobody + + +# If HTTP auth is used, it is possible to have a specific +# auth log. + +auth_log = true + + +# When we're running multiple yaws systems on the same +# host, we need to give each yaws system an individual +# name. Yaws will write a number of runtime files under +# /tmp/yaws/${id} +# The default value is "default" + + +# id = myname + + +# earlier versions of Yaws picked the first virtual host +# in a list of hosts with the same IP/PORT when the Host: +# header doesn't match any name on any Host +# This is often nice in testing environments but not +# acceptable in real live hosting scenarios + +pick_first_virthost_on_nomatch = true + + +# All unices are broken since it's not possible to bind to +# a privileged port (< 1024) unless uid==0 +# There is a contrib in jungerl which makes it possible by means +# of an external setuid root programm called fdsrv to listen to +# to privileged port. +# If we use this feature, it requires fdsrv to be properly installed. +# Doesn't yet work with SSL. + +use_fdsrv = false + + + + +# end then a set of virtual servers +# First two virthosted servers on the same IP (0.0.0.0) +# in this case, but an explicit IP can be given as well + + + port = 80 + listen = 0.0.0.0 + docroot = /var/yaws/www + arg_rewrite_mod = pwr_arg_rewrite_mod + appmods = + + + + port = 80 + listen = 0.0.0.0 + docroot = /tmp + dir_listings = true + dav = true + + realm = foobar + dir = / + user = foo:bar + user = baz:bar + + + + + +# And then an ssl server + + + port = 443 + docroot = /tmp + listen = 0.0.0.0 + dir_listings = true + + keyfile = /usr/local/yaws/etc/yaws-key.pem + certfile = /usr/local/yaws/etc/yaws-cert.pem + + + + + + + + + + diff --git a/lib/erl/src-loose/protocol/tBinaryProtocol.erl b/lib/erl/src-loose/protocol/tBinaryProtocol.erl deleted file mode 100644 index b82af73d..00000000 --- a/lib/erl/src-loose/protocol/tBinaryProtocol.erl +++ /dev/null @@ -1,232 +0,0 @@ --module(tBinaryProtocol). - --include("thrift/thrift.hrl"). --include("thrift/protocol/tBinaryProtocol.hrl"). --include("thrift/protocol/tProtocolException.hrl"). - --export([ - new/1, - trans/1, - skip/2, - - writeMessageBegin/4, writeMessageEnd/1, - writeStructBegin/2, writeStructEnd/1, - writeFieldBegin/4, writeFieldEnd/1, writeFieldStop/1, - writeMapBegin/4, writeMapEnd/1, - writeListBegin/3, writeListEnd/1, - writeSetBegin/3, writeSetEnd/1, - - writeBool/2, writeByte/2, writeI16/2, writeI32/2, - writeI64/2, writeDouble/2, writeString/2, - - readMessageBegin/1, readMessageEnd/1, - readStructBegin/1, readStructEnd/1, - readFieldBegin/1, readFieldEnd/1, - readMapBegin/1, readMapEnd/1, - readListBegin/1, readListEnd/1, - readSetBegin/1, readSetEnd/1, - - readBool/1, readByte/1, readI16/1, readI32/1, - readI64/1, readDouble/1, readString/1 -]). - -new(Trans) -> - #tBinaryProtocol{trans=Trans}. - -trans(This) -> % accessor - ?ATTR(trans). - -skip(This, Type) -> - tProtocol:skip(This, Type). - -writeMessageBegin(This, Name, Type, Seqid) -> - writeI32(This, ?VERSION_1 bor Type), - writeString(This, Name), - writeI32(This, Seqid). - -writeMessageEnd(This) -> - This, % suppress unused warnings - ok. - -writeStructBegin(This, Name) -> - This, Name, % suppress unused warnings - ok. - -writeStructEnd(This) -> - This, % suppress unused warnings - ok. - -writeFieldBegin(This, Name, Type, Id) -> - Name, - writeByte(This, Type), - writeI16(This, Id). - -writeFieldEnd(This) -> - This, % suppress unused warnings - ok. - -writeFieldStop(This) -> - writeByte(This, ?tType_STOP). - -writeMapBegin(This, Ktype, Vtype, Size) -> - writeByte(This, Ktype), - writeByte(This, Vtype), - writeI32(This, Size). - -writeMapEnd(This) -> - This, % suppress unused warnings - ok. - -writeListBegin(This, Etype, Size) -> - writeByte(This, Etype), - writeI32(This, Size). - -writeListEnd(This) -> - This, % suppress unused warnings - ok. - -writeSetBegin(This, Etype, Size) -> - writeByte(This, Etype), - writeI32(This, Size). - -writeSetEnd(This) -> - This, % suppress unused warnings - ok. - -% - -writeBool(This, Bool) -> - if Bool -> % true - writeByte(This, 1); - true -> % false - writeByte(This, 0) - end. - -writeByte(This, Byte) -> - Trans = This#tBinaryProtocol.trans, - ?M1(Trans, write, binary_to_list(<>)). - -writeI16(This, I16) -> - Trans = This#tBinaryProtocol.trans, - ?M1(Trans, write, binary_to_list(<>)). - -writeI32(This, I32) -> - Trans = This#tBinaryProtocol.trans, - ?M1(Trans, write, binary_to_list(<>)). - -writeI64(This, I64) -> - Trans = This#tBinaryProtocol.trans, - ?M1(Trans, write, binary_to_list(<>)). - -writeDouble(This, Double) -> - Trans = This#tBinaryProtocol.trans, - ?M1(Trans, write, binary_to_list(<>)). - -writeString(This, Str) -> - Trans = This#tBinaryProtocol.trans, - writeI32(This, length(Str)), - ?M1(Trans, write, Str). - -% - -readMessageBegin(This) -> - Version = readI32(This), - if - (Version band ?VERSION_MASK) /= ?VERSION_1 -> - throw(tProtocolException:new(?tProtocolException_BAD_VERSION, - "Missing version identifier")); - true -> ok - end, - Type = Version band 16#000000ff, - Name = readString(This), - Seqid = readI32(This), - { Name, Type, Seqid }. - -readMessageEnd(This) -> - This, % suppress unused warnings - ok. - -readStructBegin(This) -> - This, % suppress unused warnings - ok. - -readStructEnd(This) -> - This, % suppress unused warnings - ok. - -readFieldBegin(This) -> - Type = readByte(This), - if Type == ?tType_STOP -> - { nil, Type, 0 }; % WATCH - true -> - Id = readI16(This), - { nil, Type, Id } - end. - -readFieldEnd(This) -> - This, % suppress unused warnings - ok. - -readMapBegin(This) -> - Ktype = readByte(This), - Vtype = readByte(This), - Size = readI32(This), - { Ktype, Vtype, Size }. - -readMapEnd(This) -> - This, % suppress unused warnings - ok. - -readListBegin(This) -> - Etype = readByte(This), - Size = readI32(This), - { Etype, Size }. - -readListEnd(This) -> - This, % suppress unused warnings - ok. - -readSetBegin(This) -> - Etype = readByte(This), - Size = readI32(This), - { Etype, Size }. - -readSetEnd(This) -> - This, % suppress unused warnings - ok. - -% WATCH everything ... who knows what of this will work - -readBool(This) -> - Byte = readByte(This), - (Byte /= 0). - -readByte(This) -> - Trans = This#tBinaryProtocol.trans, - <> = ?M1(Trans, readAll, 1), - Val. - -readI16(This) -> - Trans = This#tBinaryProtocol.trans, - <> = ?M1(Trans, readAll, 2), - Val. - -readI32(This) -> - Trans = This#tBinaryProtocol.trans, - <> = ?M1(Trans, readAll, 4), - Val. - -readI64(This) -> - Trans = This#tBinaryProtocol.trans, - <> = ?M1(Trans, readAll, 8), - Val. - -readDouble(This) -> - Trans = This#tBinaryProtocol.trans, - <> = ?M1(Trans, readAll, 8), - Val. - -readString(This) -> - Trans = This#tBinaryProtocol.trans, - Sz = readI32(This), - binary_to_list(?M1(Trans, readAll, Sz)). diff --git a/lib/erl/src-loose/protocol/tBinaryProtocol.hrl b/lib/erl/src-loose/protocol/tBinaryProtocol.hrl deleted file mode 100644 index cfd48367..00000000 --- a/lib/erl/src-loose/protocol/tBinaryProtocol.hrl +++ /dev/null @@ -1,4 +0,0 @@ --define(VERSION_MASK, 16#FFFF0000). --define(VERSION_1, 16#80010000). --record(tBinaryProtocol, {trans}). - diff --git a/lib/erl/src-loose/protocol/tProtocol.erl b/lib/erl/src-loose/protocol/tProtocol.erl deleted file mode 100644 index a36ca113..00000000 --- a/lib/erl/src-loose/protocol/tProtocol.erl +++ /dev/null @@ -1,69 +0,0 @@ --module(tProtocol). - --include("thrift/thrift.hrl"). --include("thrift/protocol/tProtocol.hrl"). - --export([new/1, skip/2]). - -skip_struct_loop(This) -> - { Name, Type, Id } = ?M0(This, readFieldBegin), - Name, Id, % suppress unused warnings - if - Type == ?tType_STOP -> - ok; - true -> - skip(This, Type), - ?M0(This, readFieldEnd), - - %% this is here in original tprotocol.rb, but i think it's a bug - % ?M0(This, readStructEnd), - skip_struct_loop(This) - end. - -skip_map_repeat(This, Ktype, Vtype, Times) -> - skip(This, Ktype), - skip(This, Vtype), - skip_map_repeat(This, Ktype, Vtype, Times-1). - -skip_set_repeat(This, Etype, Times) -> - skip(This, Etype), - skip_set_repeat(This, Etype, Times-1). - -new(Trans) -> - #tProtocol{trans=Trans}. - -skip(This, Type) -> - case Type of - ?tType_STOP -> nil; % WATCH - ?tType_BOOL -> ?M0(This, readBool); - ?tType_BYTE -> ?M0(This, readByte); - ?tType_I16 -> ?M0(This, readI16); - ?tType_I32 -> ?M0(This, readI32); - ?tType_I64 -> ?M0(This, readI64); - ?tType_DOUBLE -> ?M0(This, readDouble); - ?tType_STRING -> ?M0(This, readString); - - ?tType_STRUCT -> - ?M0(This, readStructBegin), - skip_struct_loop(This), - - %% this isn't here in the original tprotocol.rb, but i think it's a bug - ?M0(This, readStructEnd); - - ?tType_MAP -> - {Ktype, Vtype, Size} = ?M0(This, readMapBegin), - skip_map_repeat(This, Ktype, Vtype, Size), - ?M0(This, readMapEnd); - - ?tType_SET -> - {Etype, Size} = ?M0(This, readSetBegin), - skip_set_repeat(This, Etype, Size), - ?M0(This, readSetEnd); - - ?tType_LIST -> - {Etype, Size} = ?M0(This, readListBegin), - skip_set_repeat(This, Etype, Size), % [sic] skipping same as for SET - ?M0(This, readListEnd) - end. - - diff --git a/lib/erl/src-loose/protocol/tProtocol.hrl b/lib/erl/src-loose/protocol/tProtocol.hrl deleted file mode 100644 index 43851240..00000000 --- a/lib/erl/src-loose/protocol/tProtocol.hrl +++ /dev/null @@ -1 +0,0 @@ --record(tProtocol, {trans}). diff --git a/lib/erl/src-loose/protocol/tProtocolException.erl b/lib/erl/src-loose/protocol/tProtocolException.erl deleted file mode 100644 index b9aa48a6..00000000 --- a/lib/erl/src-loose/protocol/tProtocolException.erl +++ /dev/null @@ -1,9 +0,0 @@ --module(tProtocolException). --include("tProtocolException.hrl"). --export([new/2, new/1, new/0]). - -new(Type, Message) -> - #tProtocolException{type=Type, message=Message}. - -new(Type) -> new(Type, nil). -new() -> new(?tProtocolException_UNKNOWN, nil). diff --git a/lib/erl/src-loose/protocol/tProtocolException.hrl b/lib/erl/src-loose/protocol/tProtocolException.hrl deleted file mode 100644 index 96bf3acb..00000000 --- a/lib/erl/src-loose/protocol/tProtocolException.hrl +++ /dev/null @@ -1,8 +0,0 @@ --record(tProtocolException, {message, type}). - --define(tProtocolException_UNKNOWN, 0). --define(tProtocolException_INVALID_DATA, 1). --define(tProtocolException_NEGATIVE_SIZE, 2). --define(tProtocolException_SIZE_LIMIT, 3). --define(tProtocolException_BAD_VERSION, 4). - diff --git a/lib/erl/src-loose/server/tServer.erl b/lib/erl/src-loose/server/tServer.erl deleted file mode 100644 index 0c3182e0..00000000 --- a/lib/erl/src-loose/server/tServer.erl +++ /dev/null @@ -1,62 +0,0 @@ --module(tServer). - --include("thrift/thrift.hrl"). --include("thrift/protocol/tProtocol.hrl"). --include("thrift/protocol/tBinaryProtocol.hrl"). -% -include("thrift/transport/tTransport.hrl"). --include("tServer.hrl"). - --export([new/3, serve/1]). - -% now processor is the module with process_*, not an object - -new(ProcessorModule, HandlerModule, ServerTransport) -> - #tServer{processorModule=ProcessorModule, - handlerModule=HandlerModule, - serverTransport=ServerTransport}. - -serverTransport(This) -> - This#tServer.serverTransport. - -serve(This) -> - ST1 = ?M0(serverTransport(This), listen_MUTABLE), - This1 = This#tServer{serverTransport=ST1}, - serve_loop(This1). - -processorModule(This) -> - This#tServer.processorModule. - -handlerModule(This) -> - This#tServer.handlerModule. - -serve_loop(This) -> - io:format("~nready.~n", []), - Client = ?M0(serverTransport(This), accept_MUTABLE), - This1 = This#tServer{serverTransport=Client}, - - Trans = Client, % factory - Prot = tBinaryProtocol:new(Trans), - serve_loop_loop(This1, Prot), % giggle loop? - ?M0(Trans, close_MUTABLE), % don't "assign" ... discard - serve_loop(This). - -serve_loop_loop(This, Prot) -> - Next = try - Val = (processorModule(This)):process(handlerModule(This), Prot, Prot), - io:format("request processed: rv=~p~n", [Val]), - loop - catch - %% TODO(cpiro) case when is_record(...) to pick out our exception - %% records vs. normal erlang throws - {tTransportException,_,_} -> - io:format("tTransportException (normal-ish?)~n", []), - close; - E -> - io:format("EXCEPTION: ~p~n", [E]), - close - end, - case Next of - loop -> serve_loop_loop(This, Prot); - close -> ok - end. - diff --git a/lib/erl/src-loose/server/tServer.hrl b/lib/erl/src-loose/server/tServer.hrl deleted file mode 100644 index 23da0290..00000000 --- a/lib/erl/src-loose/server/tServer.hrl +++ /dev/null @@ -1 +0,0 @@ --record(tServer, {processorModule, handlerModule, serverTransport}). diff --git a/lib/erl/src-loose/tApplicationException.erl b/lib/erl/src-loose/tApplicationException.erl deleted file mode 100644 index c6453a39..00000000 --- a/lib/erl/src-loose/tApplicationException.erl +++ /dev/null @@ -1,64 +0,0 @@ --module(tApplicationException). - --include("thrift.hrl"). -% -include("tApplicationException.hrl"). - --export([new/0, new/1, new/2, read/2, write/2]). - -new(Type, Message) -> - #tApplicationException{type=Type, message=Message}. - -new() -> new(?tApplicationException_UNKNOWN, nil). % WATCH -new(Type) -> new(Type, nil). % WATCH - -read(This, Iprot) -> - ?M0(Iprot, readStructBegin), - read_while_loop(This, Iprot), - ?M0(Iprot, readStructEnd), - This. - -read_while_loop(This, Iprot) -> - {_, Ftype, Fid} = ?M0(Iprot, readFieldBegin), % field = {fname, ftype, fid} - - if - Ftype == ?tType_STOP -> - This; - (Fid == 1) and (Ftype == ?tType_STRING) -> - This1 = This#tApplicationException{message=?M0(Iprot, readString)}, - ?M0(Iprot, readFieldEnd), - read_while_loop(This1, Iprot); - - Fid == 1 -> - ?M0(Iprot, skip), - ?M0(Iprot, readFieldEnd), - read_while_loop(This, Iprot); - - (Fid == 2) and (Ftype == ?tType_I32) -> - This1 = This#tApplicationException{type=?M0(Iprot, readI32)}, - ?M0(Iprot, readFieldEnd), - read_while_loop(This1, Iprot); - - true -> - ?M0(Iprot, skip), - ?M0(Iprot, readFieldEnd), - read_while_loop(This, Iprot) - end. - -write(This, Oprot) -> - ?M1(Oprot, writeStructBegin, "tApplicationException"), - Message = This#tApplicationException.message, - Type = This#tApplicationException.type, - if Message /= undefined -> - ?M3(Oprot, writeFieldBegin, "message", ?tType_STRING, 1), - ?M1(Oprot, writeString, Message), - ?M0(Oprot, writeFieldEnd); - true -> ok - end, - if Type /= undefined -> - ?M3(Oprot, writeFieldBegin, "type", ?tType_I32, 2), - ?M1(Oprot, writeI32, Type), - ?M0(Oprot, writeFieldEnd); - true -> ok - end, - ?M0(Oprot, writeFieldStop), - ?M0(Oprot, writeStructEnd). diff --git a/lib/erl/src-loose/tException.erl b/lib/erl/src-loose/tException.erl deleted file mode 100644 index 3a4a9e86..00000000 --- a/lib/erl/src-loose/tException.erl +++ /dev/null @@ -1,7 +0,0 @@ --module(tException). --include("tException.hrl"). --export([new/0]). - -new() -> - #tException{}. - diff --git a/lib/erl/src-loose/tException.hrl b/lib/erl/src-loose/tException.hrl deleted file mode 100644 index 6b105519..00000000 --- a/lib/erl/src-loose/tException.hrl +++ /dev/null @@ -1 +0,0 @@ --record(tException, {message}). diff --git a/lib/erl/src-loose/thrift.hrl b/lib/erl/src-loose/thrift.hrl deleted file mode 100644 index 845d61c8..00000000 --- a/lib/erl/src-loose/thrift.hrl +++ /dev/null @@ -1,36 +0,0 @@ --define(CLASS(Obj), element(1,Obj)). - --define(M0(Obj, Method), ((?CLASS(Obj)):Method(Obj))). --define(M1(Obj, Method, Arg1), ((?CLASS(Obj)):Method(Obj, Arg1))). --define(M2(Obj, Method, Arg1, Arg2), ((?CLASS(Obj)):Method(Obj, Arg1, Arg2))). --define(M3(Obj, Method, Arg1, Arg2, Arg3), ((?CLASS(Obj)):Method(Obj, Arg1, Arg2, Arg3))). --define(M4(Obj, Method, Arg1, Arg2, Arg3, Arg4), ((?CLASS(Obj)):Method(Obj, Arg1, Arg2, Arg3, Arg4))). --define(M5(Obj, Method, Arg1, Arg2, Arg3, Arg4, Arg5), ((?CLASS(Obj)):Method(Obj, Arg1, Arg2, Arg3, Arg4, Arg5))). --define(M6(Obj, Method, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6), ((?CLASS(Obj)):Method(Obj, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6))). - --define(ATTR(X), This#?MODULE.X). - -%% TType --define(tType_STOP, 0). --define(tType_VOID, 1). --define(tType_BOOL, 2). --define(tType_BYTE, 3). --define(tType_DOUBLE, 4). --define(tType_I16, 6). --define(tType_I32, 8). --define(tType_I64, 10). --define(tType_STRING, 11). --define(tType_STRUCT, 12). --define(tType_MAP, 13). --define(tType_SET, 14). --define(tType_LIST, 15). - -% tmessagetype --define(tMessageType_CALL, 1). --define(tMessageType_REPLY, 2). --define(tMessageType_EXCEPTION, 3). - -% TProcessor -% ? - --include("thrift/tApplicationException.hrl"). diff --git a/lib/erl/src-loose/transport/tBufferedTransport.erl b/lib/erl/src-loose/transport/tBufferedTransport.erl deleted file mode 100644 index 1cc809de..00000000 --- a/lib/erl/src-loose/transport/tBufferedTransport.erl +++ /dev/null @@ -1,34 +0,0 @@ --module(tBufferedTransport). - --include("thrift/thrift.hrl"). --include("thrift/transport/tBufferedTransport.hrl"). - --export([new/1, isOpen/1, open/1, close/1, read/2, write_MUTABLE/2, flush_MUTABLE/1]). - -new(Transport) -> - #tBufferedTransport{transport=Transport, wbuf=""}. - -transport(This) -> % local accessor - This#tBufferedTransport.transport. - -isOpen(This) -> - ?M0(transport(This), isOpen). - -open(This) -> - ?M0(transport(This), open). - -close(This) -> - ?M0(transport(This), close). - -read(This, Sz) -> - ?M1(transport(This), read, Sz). - -write_MUTABLE(This, Buf) -> % be sure to rebind This to the retval - Wbuf = This#tBufferedTransport.wbuf, - This#tBufferedTransport{wbuf=Wbuf++Buf}. % TODO: ++ efficiency? - -flush_MUTABLE(This) -> % be sure to rebind This to the retval - Wbuf = This#tBufferedTransport.wbuf, - ?M1(transport(This), write, Wbuf), - ?M0(transport(This), flush), - This#tBufferedTransport{wbuf=""}. % TODO: ++ efficiency? diff --git a/lib/erl/src-loose/transport/tBufferedTransport.hrl b/lib/erl/src-loose/transport/tBufferedTransport.hrl deleted file mode 100644 index d8d71e1b..00000000 --- a/lib/erl/src-loose/transport/tBufferedTransport.hrl +++ /dev/null @@ -1 +0,0 @@ --record(tBufferedTransport, {transport, wbuf}). diff --git a/lib/erl/src-loose/transport/tServerSocket.erl b/lib/erl/src-loose/transport/tServerSocket.erl deleted file mode 100644 index 239af6ef..00000000 --- a/lib/erl/src-loose/transport/tServerSocket.erl +++ /dev/null @@ -1,44 +0,0 @@ --module(tServerSocket). --include("tServerSocket.hrl"). - --export([new/1, listen_MUTABLE/1, accept_MUTABLE/1, close/1]). - -new(Port) -> - #tServerSocket{port=Port, handle=nil}. - -listen_MUTABLE(This) -> - Port = This#tServerSocket.port, - Options = [binary, {packet, 0}, {active, false}], % was [] - - case gen_tcp:listen(Port, Options) of - {ok, ListenSocket} -> - This#tServerSocket{handle=ListenSocket} - % {error, _} -> - % TODO: no error handling in Ruby version? - end. - -accept_MUTABLE(This) -> - if - This#tServerSocket.handle /= nil -> - case gen_tcp:accept(This#tServerSocket.handle) of - {ok, Socket} -> - tSocket:setHandle_MUTABLE( tSocket:new(), Socket ) - % {error, _} -> - % TODO: no error handling in Ruby version? - end; - true -> - nil - end. - -close(This) -> - if - This#tServerSocket.handle /= nil -> - case gen_tcp:close(This#tServerSocket.handle) of - ok -> - ok - % {error, _} -> - % TODO: no error handling in Ruby version? - end; - true -> - ok - end. diff --git a/lib/erl/src-loose/transport/tServerSocket.hrl b/lib/erl/src-loose/transport/tServerSocket.hrl deleted file mode 100644 index 34ed3208..00000000 --- a/lib/erl/src-loose/transport/tServerSocket.hrl +++ /dev/null @@ -1 +0,0 @@ --record(tServerSocket, {port, handle}). diff --git a/lib/erl/src-loose/transport/tSocket.erl b/lib/erl/src-loose/transport/tSocket.erl deleted file mode 100644 index 850c3b92..00000000 --- a/lib/erl/src-loose/transport/tSocket.erl +++ /dev/null @@ -1,96 +0,0 @@ --module(tSocket). - --include("thrift/thrift.hrl"). --include("thrift/transport/tTransportException.hrl"). -% -include("thrift/transport/tTransport.hrl"). --include("thrift/transport/tSocket.hrl"). - --export([new/0, new/1, new/2, setHandle_MUTABLE/2, open_MUTABLE/1, isOpen/1, write/2, read/2, close_MUTABLE/1, readAll/2]). - -new(Host, Port) -> - #tSocket{host=Host, port=Port, handle=nil}. % WATCH - -new() -> new("localhost", 9090). -new(Host) -> new(Host, 9090). - -setHandle_MUTABLE(This, Handle) -> - This#tSocket{handle=Handle}. - -open_MUTABLE(This) -> - Host = This#tSocket.host, - Port = This#tSocket.port, - Options = [], - - case gen_tcp:connect(Host, Port, Options) of - {error, _} -> - throw(tTransportException:new( - ?tTransportException_NOT_OPEN, - "Could not connect to " ++ Host ++ ":" ++ Port) - ), - {error, This}; % cpiro not reached? - {ok, Socket} -> - {ok, This#tSocket{handle=Socket}} - end. - -handle(This) -> - This#tSocket.handle. - -isOpen(This) -> - handle(This) /= nil. - -write(This, Str) -> - Val = gen_tcp:send(handle(This), Str), - - %% io:format("WRITE |~p|(~p)~n", [Str,Val]), - - case Val of - {error, _} -> - throw(tTransportException:new(?tTransportException_NOT_OPEN, "in write")); - ok -> - ok - end. - -read(This, Sz) -> - case gen_tcp:recv(handle(This), Sz) of - {ok, []} -> - { Host, Port } = { This#tSocket.host, This#tSocket.port }, - throw(tTransportException:new(?tTransportException_UNKNOWN, "TSocket: Could not read " ++ Sz ++ "bytes from " ++ Host ++ ":" ++ Port)); - {ok, Data} -> - Data; - {error, Error} -> - io:format("in tSocket:read/2: gen_tcp:recv(~p, ~p) => {error, ~p}~n", - [handle(This), Sz, Error]), - throw(tTransportException:new(?tTransportException_NOT_OPEN, "in tSocket:read/2: gen_tcp:recv")) - end. - -close_MUTABLE(This) -> - if - This#tSocket.handle == nil -> - This; - true -> - gen_tcp:close(handle(This)), - This#tSocket{handle=nil} - end. - -readAll(This, Sz) -> - readAll_loop(This, Sz, "", 0). - -readAll_loop(This, Sz, Buff, Have) -> - if - Have < Sz -> - Chunk = ?M1(This, read, Sz - Have), - - %% man gen_tcp: - %% exactly Length bytes are returned, or an error; - %% possibly discarding less than Length bytes of data when - %% the socket gets closed from the other side. - - %% io:format("READ |~p|~n", [Chunk]), - - Have1 = Have + (Sz-Have), % length(Chunk) - Buff1 = Buff ++ Chunk, % TODO: ++ efficiency? - readAll_loop(This, Sz, Buff1, Have1); - true -> - Buff - end. - diff --git a/lib/erl/src-loose/transport/tSocket.hrl b/lib/erl/src-loose/transport/tSocket.hrl deleted file mode 100644 index dc1cc20e..00000000 --- a/lib/erl/src-loose/transport/tSocket.hrl +++ /dev/null @@ -1 +0,0 @@ --record(tSocket, {host, port, handle}). diff --git a/lib/erl/src-loose/transport/tTransport.erl b/lib/erl/src-loose/transport/tTransport.erl deleted file mode 100644 index 91b7228e..00000000 --- a/lib/erl/src-loose/transport/tTransport.erl +++ /dev/null @@ -1,4 +0,0 @@ --module(tTransport). - --include("thrift/transport/tTransportException.hrl"). - diff --git a/lib/erl/src-loose/transport/tTransportException.erl b/lib/erl/src-loose/transport/tTransportException.erl deleted file mode 100644 index b31bb203..00000000 --- a/lib/erl/src-loose/transport/tTransportException.erl +++ /dev/null @@ -1,15 +0,0 @@ --module(tTransportException). - --include("thrift/thrift.hrl"). --include("thrift/transport/tTransportException.hrl"). - --export([new/0, new/1, new/2, message/1]). - -new(Type, Message) -> - #tTransportException{type = Type, message = Message}. - -new() -> new(?tTransportException_UNKNOWN, nil). % WATCH -new(Type) -> new(Type, nil). % WATCH - -message(This) -> - ?ATTR(message). diff --git a/lib/erl/src-loose/transport/tTransportException.hrl b/lib/erl/src-loose/transport/tTransportException.hrl deleted file mode 100644 index fa8554b0..00000000 --- a/lib/erl/src-loose/transport/tTransportException.hrl +++ /dev/null @@ -1,7 +0,0 @@ --define(tTransportException_UNKNOWN, 0). --define(tTransportException_NOT_OPEN, 1). --define(tTransportException_ALREADY_OPEN, 2). --define(tTransportException_TIMED_OUT, 3). --define(tTransportException_END_OF_FILE, 4). - --record(tTransportException, {type, message}). diff --git a/lib/erl/thrift b/lib/erl/thrift deleted file mode 120000 index 1ab4c5cd..00000000 --- a/lib/erl/thrift +++ /dev/null @@ -1 +0,0 @@ -src-loose \ No newline at end of file diff --git a/lib/erl/tools/.appgen/blank_app/Makefile b/lib/erl/tools/.appgen/blank_app/Makefile new file mode 100755 index 00000000..0f2c8a82 --- /dev/null +++ b/lib/erl/tools/.appgen/blank_app/Makefile @@ -0,0 +1,7 @@ +MODULES = \ + src + +all clean docs: + for dir in $(MODULES); do \ + (cd $$dir; ${MAKE} $@); \ + done diff --git a/lib/erl/tools/.appgen/blank_app/include/blank_app.hrl b/lib/erl/tools/.appgen/blank_app/include/blank_app.hrl new file mode 100755 index 00000000..e69de29b diff --git a/lib/erl/tools/.appgen/blank_app/src/Makefile b/lib/erl/tools/.appgen/blank_app/src/Makefile new file mode 100755 index 00000000..13b06f05 --- /dev/null +++ b/lib/erl/tools/.appgen/blank_app/src/Makefile @@ -0,0 +1,112 @@ +# $Id: Makefile,v 1.3 2004/08/13 16:35:59 mlogan Exp $ +# +include ../../../build/otp.mk +include ../../../build/colors.mk +include ../../../build/buildtargets.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- + +include ../vsn.mk +APP_NAME=%%APP_NAME%% +PFX=%%PFX%% +VSN=$(%%APP_NAME_UPPER_CASE%%_VSN) + +# ---------------------------------------------------- +# Install directory specification +# WARNING: INSTALL_DIR the command to install a directory. +# INSTALL_DST is the target directory +# ---------------------------------------------------- +INSTALL_DST = $(ERLANG_OTP)/lib/$(APP_NAME)-$(VSN) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- + + +MODULES = $(shell ls *.erl | sed s/.erl//) +MODULES_COMMA = $(shell ls *.erl | sed s/\\.erl/,/) + +HRL_FILES= +INTERNAL_HRL_FILES= $(APP_NAME).hrl +ERL_FILES= $(MODULES:%=%.erl) +DOC_FILES=$(ERL_FILES) + +APP_FILE= $(APP_NAME).app +APPUP_FILE= $(APP_NAME).appup + +APP_SRC= $(APP_FILE).src +APPUP_SRC= $(APPUP_FILE).src + +APP_TARGET= $(EBIN)/$(APP_FILE) +APPUP_TARGET= $(EBIN)/$(APPUP_FILE) + +BEAMS= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) +TARGET_FILES= $(BEAMS) $(APP_TARGET) $(APPUP_TARGET) + +WEB_TARGET=/var/yaws/www/$(APP_NAME) + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- + +ERL_FLAGS += +ERL_COMPILE_FLAGS += -I../include -I../../fslib/include -I../../system_status/include + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +all debug opt: $(EBIN) $(TARGET_FILES) + +#$(EBIN)/rm_logger.beam: $(APP_NAME).hrl +include ../../../build/docs.mk + +# Note: In the open-source build clean must not destroy the preloaded +# beam files. +clean: + rm -f $(TARGET_FILES) + rm -f core + rm -rf $(EBIN) + rm -rf *html + +$(EBIN): + mkdir $(EBIN) + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + +$(APP_TARGET): $(APP_SRC) ../vsn.mk $(BEAMS) + sed -e 's;%VSN%;$(VSN);' \ + -e 's;%PFX%;$(PFX);' \ + -e 's;%APP_NAME%;$(APP_NAME);' \ + -e 's;%MODULES%;%MODULES%$(MODULES_COMMA);' \ + $< > $<".tmp" + sed -e 's/%MODULES%\(.*\),/\1/' \ + $<".tmp" > $@ + rm $<".tmp" + + +$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +$(WEB_TARGET): ../markup/* + rm -rf $(WEB_TARGET) + mkdir $(WEB_TARGET) + cp -r ../markup/ $(WEB_TARGET) + cp -r ../skins/ $(WEB_TARGET) + +# ---------------------------------------------------- +# Install Target +# ---------------------------------------------------- + +install: all $(WEB_TARGET) +# $(INSTALL_DIR) $(INSTALL_DST)/src +# $(INSTALL_DATA) $(ERL_FILES) $(INSTALL_DST)/src +# $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(INSTALL_DST)/src +# $(INSTALL_DIR) $(INSTALL_DST)/include +# $(INSTALL_DATA) $(HRL_FILES) $(INSTALL_DST)/include +# $(INSTALL_DIR) $(INSTALL_DST)/ebin +# $(INSTALL_DATA) $(TARGET_FILES) $(INSTALL_DST)/ebin diff --git a/lib/erl/tools/.appgen/blank_app/src/ba_server.erl b/lib/erl/tools/.appgen/blank_app/src/ba_server.erl new file mode 100755 index 00000000..9a98f1cc --- /dev/null +++ b/lib/erl/tools/.appgen/blank_app/src/ba_server.erl @@ -0,0 +1,124 @@ +%%%------------------------------------------------------------------- +%%% @doc +%%% @end +%%%------------------------------------------------------------------- +-module(%%PFX%%_server). + +-behaviour(gen_server). +%%-------------------------------------------------------------------- +%% Include files +%%-------------------------------------------------------------------- +-include("%%APP_NAME%%.hrl"). + +%%-------------------------------------------------------------------- +%% External exports +%%-------------------------------------------------------------------- +-export([ + start_link/0, + stop/0 + ]). + +%%-------------------------------------------------------------------- +%% gen_server callbacks +%%-------------------------------------------------------------------- +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). + +%%-------------------------------------------------------------------- +%% record definitions +%%-------------------------------------------------------------------- +-record(state, {}). + +%%-------------------------------------------------------------------- +%% macro definitions +%%-------------------------------------------------------------------- +-define(SERVER, ?MODULE). + +%%==================================================================== +%% External functions +%%==================================================================== +%%-------------------------------------------------------------------- +%% @doc Starts the server. +%% @spec start_link() -> {ok, pid()} | {error, Reason} +%% @end +%%-------------------------------------------------------------------- +start_link() -> + gen_server:start_link({local, ?SERVER}, ?MODULE, [], []). + +%%-------------------------------------------------------------------- +%% @doc Stops the server. +%% @spec stop() -> ok +%% @end +%%-------------------------------------------------------------------- +stop() -> + gen_server:cast(?SERVER, stop). + +%%==================================================================== +%% Server functions +%%==================================================================== + +%%-------------------------------------------------------------------- +%% Function: init/1 +%% Description: Initiates the server +%% Returns: {ok, State} | +%% {ok, State, Timeout} | +%% ignore | +%% {stop, Reason} +%%-------------------------------------------------------------------- +init([]) -> + {ok, #state{}}. + +%%-------------------------------------------------------------------- +%% Function: handle_call/3 +%% Description: Handling call messages +%% Returns: {reply, Reply, State} | +%% {reply, Reply, State, Timeout} | +%% {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, Reply, State} | (terminate/2 is called) +%% {stop, Reason, State} (terminate/2 is called) +%%-------------------------------------------------------------------- +handle_call(Request, From, State) -> + Reply = ok, + {reply, Reply, State}. + +%%-------------------------------------------------------------------- +%% Function: handle_cast/2 +%% Description: Handling cast messages +%% Returns: {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} (terminate/2 is called) +%%-------------------------------------------------------------------- +handle_cast(stop, State) -> + {stop, normal, State}; +handle_cast(Msg, State) -> + {noreply, State}. + +%%-------------------------------------------------------------------- +%% Function: handle_info/2 +%% Description: Handling all non call/cast messages +%% Returns: {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} (terminate/2 is called) +%%-------------------------------------------------------------------- +handle_info(Info, State) -> + {noreply, State}. + +%%-------------------------------------------------------------------- +%% Function: terminate/2 +%% Description: Shutdown the server +%% Returns: any (ignored by gen_server) +%%-------------------------------------------------------------------- +terminate(Reason, State) -> + ok. + +%%-------------------------------------------------------------------- +%% Func: code_change/3 +%% Purpose: Convert process state when code is changed +%% Returns: {ok, NewState} +%%-------------------------------------------------------------------- +code_change(OldVsn, State, Extra) -> + {ok, State}. + +%%==================================================================== +%%% Internal functions +%%==================================================================== diff --git a/lib/erl/tools/.appgen/blank_app/src/ba_sup.erl b/lib/erl/tools/.appgen/blank_app/src/ba_sup.erl new file mode 100755 index 00000000..b5f48d11 --- /dev/null +++ b/lib/erl/tools/.appgen/blank_app/src/ba_sup.erl @@ -0,0 +1,74 @@ +%%%------------------------------------------------------------------- +%%% @doc +%%% @end +%%%------------------------------------------------------------------- +-module(%%PFX%%_sup). + +-behaviour(supervisor). +%%-------------------------------------------------------------------- +%% Include files +%%-------------------------------------------------------------------- + +%%-------------------------------------------------------------------- +%% External exports +%%-------------------------------------------------------------------- +-export([ + start_link/1 + ]). + +%%-------------------------------------------------------------------- +%% Internal exports +%%-------------------------------------------------------------------- +-export([ + init/1 + ]). + +%%-------------------------------------------------------------------- +%% Macros +%%-------------------------------------------------------------------- +-define(SERVER, ?MODULE). + +%%-------------------------------------------------------------------- +%% Records +%%-------------------------------------------------------------------- + +%%==================================================================== +%% External functions +%%==================================================================== +%%-------------------------------------------------------------------- +%% @doc Starts the supervisor. +%% @spec start_link(StartArgs) -> {ok, pid()} | Error +%% @end +%%-------------------------------------------------------------------- +start_link(StartArgs) -> + supervisor:start_link({local, ?SERVER}, ?MODULE, []). + +%%==================================================================== +%% Server functions +%%==================================================================== +%%-------------------------------------------------------------------- +%% Func: init/1 +%% Returns: {ok, {SupFlags, [ChildSpec]}} | +%% ignore | +%% {error, Reason} +%%-------------------------------------------------------------------- +init([]) -> + RestartStrategy = one_for_one, + MaxRestarts = 1000, + MaxTimeBetRestarts = 3600, + + SupFlags = {RestartStrategy, MaxRestarts, MaxTimeBetRestarts}, + + ChildSpecs = + [ + {%%PFX%%_server, + {%%PFX%%_server, start_link, []}, + permanent, + 1000, + worker, + [%%PFX%%_server]} + ], + {ok,{SupFlags, ChildSpecs}}. +%%==================================================================== +%% Internal functions +%%==================================================================== diff --git a/lib/erl/tools/.appgen/blank_app/src/blank_app.app.src b/lib/erl/tools/.appgen/blank_app/src/blank_app.app.src new file mode 100755 index 00000000..a1513fb9 --- /dev/null +++ b/lib/erl/tools/.appgen/blank_app/src/blank_app.app.src @@ -0,0 +1,41 @@ +%%% -*- mode:erlang -*- +{application, %APP_NAME%, + [ + % A quick description of the application. + {description, "An Erlang Application."}, + + % The version of the applicaton + {vsn, "%VSN%"}, + + % All modules used by the application. + {modules, + [ + %MODULES% + ]}, + + % All of the registered names the application uses. This can be ignored. + {registered, []}, + + % Applications that are to be started prior to this one. This can be ignored + % leave it alone unless you understand it well and let the .rel files in + % your release handle this. + {applications, + [ + kernel, + stdlib + ]}, + + % OTP application loader will load, but not start, included apps. Again + % this can be ignored as well. To load but not start an application it + % is easier to include it in the .rel file followed by the atom 'none' + {included_applications, []}, + + % configuration parameters similar to those in the config file specified + % on the command line. can be fetched with gas:get_env + {env, []}, + + % The Module and Args used to start this application. + {mod, {%APP_NAME%, []}} + ] +}. + diff --git a/lib/erl/tools/.appgen/blank_app/src/blank_app.appup.src b/lib/erl/tools/.appgen/blank_app/src/blank_app.appup.src new file mode 100755 index 00000000..54a63833 --- /dev/null +++ b/lib/erl/tools/.appgen/blank_app/src/blank_app.appup.src @@ -0,0 +1 @@ +{"%VSN%",[],[]}. diff --git a/lib/erl/tools/.appgen/blank_app/src/blank_app.erl b/lib/erl/tools/.appgen/blank_app/src/blank_app.erl new file mode 100755 index 00000000..8db6fe03 --- /dev/null +++ b/lib/erl/tools/.appgen/blank_app/src/blank_app.erl @@ -0,0 +1,63 @@ +%%%------------------------------------------------------------------- +%%% @doc +%%% @end +%%%------------------------------------------------------------------- +-module(%%APP_NAME%%). + +-behaviour(application). +%%-------------------------------------------------------------------- +%% Include files +%%-------------------------------------------------------------------- +-include("%%APP_NAME%%.hrl"). + +%%-------------------------------------------------------------------- +%% External exports +%%-------------------------------------------------------------------- +-export([ + start/2, + shutdown/0, + stop/1 + ]). + +%%-------------------------------------------------------------------- +%% Macros +%%-------------------------------------------------------------------- + +%%-------------------------------------------------------------------- +%% Records +%%-------------------------------------------------------------------- + +%%==================================================================== +%% External functions +%%==================================================================== +%%-------------------------------------------------------------------- +%% @doc The starting point for an erlang application. +%% @spec start(Type, StartArgs) -> {ok, Pid} | {ok, Pid, State} | {error, Reason} +%% @end +%%-------------------------------------------------------------------- +start(Type, StartArgs) -> + case %%PFX%%_sup:start_link(StartArgs) of + {ok, Pid} -> + {ok, Pid}; + Error -> + Error + end. + +%%-------------------------------------------------------------------- +%% @doc Called to shudown the %%APP_NAME%% application. +%% @spec shutdown() -> ok +%% @end +%%-------------------------------------------------------------------- +shutdown() -> + application:stop(%%APP_NAME%%). + +%%==================================================================== +%% Internal functions +%%==================================================================== + +%%-------------------------------------------------------------------- +%% Called upon the termintion of an application. +%%-------------------------------------------------------------------- +stop(State) -> + ok. + diff --git a/lib/erl/tools/.appgen/blank_app/vsn.mk b/lib/erl/tools/.appgen/blank_app/vsn.mk new file mode 100755 index 00000000..9ba174be --- /dev/null +++ b/lib/erl/tools/.appgen/blank_app/vsn.mk @@ -0,0 +1 @@ +%%APP_NAME_UPPER_CASE%%_VSN=1.0 diff --git a/lib/erl/tools/.appgen/blank_app_rel/Makefile b/lib/erl/tools/.appgen/blank_app_rel/Makefile new file mode 100755 index 00000000..5d35956a --- /dev/null +++ b/lib/erl/tools/.appgen/blank_app_rel/Makefile @@ -0,0 +1,298 @@ +# ---------------------------------------------------- +# Make file for creating an otp release. +# ---------------------------------------------------- + +## +# Basename of this release. +## +RELS=$(shell basename `pwd`) +APP_NAME=$(shell echo $(RELS) | sed s/_rel$$//) + +include ../../build/otp.mk + +include ./vsn.mk + +#include $(ERL_TOP)/make/target.mk +#include $(ERL_TOP)/make/$(TARGET)/otp.mk + +USR_LIBPATH=../../lib +INSTALL_DIR=/usr/local/lib +ABS_USER_LIBPATH=$(shell cd ../../lib;pwd) + +# ---------------------------------------------------- +# CREATE DIR STRUCTURE HERE +# ---------------------------------------------------- + +HTDOCS=$(wildcard $(ABS_USER_LIBPATH)/$(APP_NAME)/htdocs/*.html) \ + $(wildcard $(ABS_USER_LIBPATH)/$(APP_NAME)/htdocs/*.htm) \ + $(wildcard $(ABS_USER_LIBPATH)/$(APP_NAME)/htdocs/*.yaws) +BUILD_FILES=fs_boot_smithe.beam fs_lists.beam fs_lib.beam + +LOCAL_DIR=local +#LOCAL_DIR=$(shell cat $(RELS).rel.src |grep -m 1 '$(APP_NAME)' |awk -F '"' '{printf "%s-%s", $$2,$$4}') + +DIR_STRUCTURE= \ + $(LOCAL_DIR) \ + $(LOCAL_DIR)/log/$(REL_VSN) \ + $(LOCAL_DIR)/var/$(REL_VSN) \ + $(LOCAL_DIR)/var/$(REL_VSN)/www/conf \ + $(LOCAL_DIR)/var/$(REL_VSN)/www/htdocs + +PRODUCTION_DIR_STRUCTURE= \ + $(RELS) \ + $(RELS)/release/$(REL_VSN) \ + $(RELS)/stage \ + $(RELS)/log/$(REL_VSN) \ + $(RELS)/var/$(REL_VSN) \ + $(RELS)/var/$(REL_VSN)/www \ + $(RELS)/var/$(REL_VSN)/www/htdocs \ + $(RELS)/var/$(REL_VSN)/www/conf + +# ---------------------------------------------------- +SCRIPT_AND_BOOT_FILES= \ + $(RELS).script \ + $(RELS).boot + +LOCAL_SCRIPT_AND_BOOT_FILES= \ + $(LOCAL_DIR)/$(RELS).script \ + $(LOCAL_DIR)/$(RELS).boot + +LOCAL_HTTP_CONF= \ + $(LOCAL_DIR)/var/$(REL_VSN)/www/conf/yaws.conf \ + $(LOCAL_DIR)/var/$(REL_VSN)/www/conf/mime.types + +PRODUCTION_HTTP_CONF= \ + $(LOCAL_DIR)/var/$(REL_VSN)/www/conf/yaws.conf \ + $(LOCAL_DIR)/var/$(REL_VSN)/www/conf/mime.types + +LOCAL_TARGET_FILES=$(LOCAL_HTTP_CONF) $(LOCAL_DIR)/$(RELS).config $(LOCAL_SCRIPT_AND_BOOT_FILES) + +LOCAL_TARGETS=$(LOCAL_DIR)/$(RELS).sh vsnit $(LOCAL_TARGET_FILES) + +PRODUCTION_TARGETS=$(RELS)/build/$(REL_VSN) \ + $(RELS)/lib \ + $(RELS)/stage/$(RELS).rel.src \ + $(RELS)/stage/$(RELS).config.src \ + $(RELS)/stage/yaws.conf.src \ + $(RELS)/stage/$(RELS).sh.src \ + $(RELS)/var/$(REL_VSN)/www/htdocs \ + $(RELS)/install.sh \ + $(RELS)/release/$(REL_VSN)/clean_release + +# ---------------------------------------------------- +# TARGETS +# ---------------------------------------------------- + +all debug opt instr script: $(DIR_STRUCTURE) $(LOCAL_TARGETS) $(PRODUCTION_DIR_STRUCTURE) $(PRODUCTION_TARGETS) + @echo $(HTDOCS) + +install: stage + +tar: $(RELS)-$(LOCATION)-$(REL_VSN).tgz + +$(DIR_STRUCTURE): + mkdir -p $@ + +$(PRODUCTION_DIR_STRUCTURE): + mkdir -p $@ + +clean: + $(RM) $(REL_SCRIPTS) $(TARGET_FILES) + $(RM) -r $(LOCAL_DIR) $(PRODN_DIR) + $(RM) $(RELS).rel + $(RM) -r $(RELS) + $(RM) $(RELS)*.tgz + $(RM) $(RELS).rel.src.tmp + $(RM) $(SCRIPT_AND_BOOT_FILES) + +docs: + +# ---------------------------------------------------- +# TARGETS FOR LOCAL MODE +# ---------------------------------------------------- + +# startup script for local mode +$(LOCAL_DIR)/$(RELS).sh: + @echo '#!/bin/sh' > $@ + @echo "cd $(CURDIR)/$(LOCAL_DIR)" >> $@ + @echo "erl -name $${USER}_$(RELS) -boot $(RELS) -config $(RELS).config \$$@" >> $@ + chmod +x $@ + @echo + @echo "==== Start local node with \"sh $@\" ====" + @echo + +# Create the config file for local mode. +$(LOCAL_DIR)/$(RELS).config: $(RELS).config.src + sed -e 's;%LOG_OTP%;$(CURDIR)/$(LOCAL_DIR)/log/$(REL_VSN);' \ + -e 's;%VAR_OTP%;$(CURDIR)/$(LOCAL_DIR)/var/$(REL_VSN);' \ + -e 's;%RELS%;$(RELS);g' \ + -e 's;%HOME%;$(HOME);g' \ + -e 's;%BROADCAST_ADDRESS%;$(BROADCAST_ADDRESS);g' \ + -e 's;%CONTACT_NODE%;$(CONTACT_NODE);g' \ + -e "s;%HOSTNAME%;`hostname --long`;" \ + -e 's;%APP_NAME%;$(APP_NAME);' \ + -e 's;%APP_VERSION%;$(APP_VERSION);g' \ + $< > $@ + +# Create the httpd conf file for local mode. +$(LOCAL_DIR)/var/$(REL_VSN)/www/conf/yaws.conf: yaws.conf.src + sed -e 's;%VAR_OTP%;$(CURDIR)/$(LOCAL_DIR)/var/$(REL_VSN);' \ + -e 's;%LOG_OTP%;$(CURDIR)/$(LOCAL_DIR)/log/$(REL_VSN);' \ + -e 's;%HTDOC_ROOT%;$(ABS_USER_LIBPATH)/$(APP_NAME)/htdocs;' \ + -e 's;%APP_NAME%;$(APP_NAME);' \ + -e 's;%RELS%;$(RELS);' \ + -e 's;%USER%;$(USER);' \ + -e 's;%HTDOC_ROOT%;$(ABS_USER_LIBPATH);' \ + -e 's;%MHOST%;$(MHOST);' \ + $< > $@ + +# Create the config file for local mode. +vsnit: $(RELS).rel.src + sed -e 's;%REL_VSN%;$(REL_VSN);' \ + $< > $<.tmp + +# Create and position script and boot files for local mode. +$(LOCAL_SCRIPT_AND_BOOT_FILES): + @ erl -pz $(USR_LIBPATH)/fslib/ebin \ + -noshell \ + -s fs_lib s_apply fs_boot_smithe make_script_and_boot "[\"$(ERL_RUN_TOP)/*\", \"$(USR_LIBPATH)\"]. " \ + \"$$(basename `pwd`)".rel.src.tmp\". " \ + "[local]. " \ + -s init stop + cp $(SCRIPT_AND_BOOT_FILES) $(LOCAL_DIR)/ + +$(LOCAL_DIR)/var/$(REL_VSN)/www/conf/mime.types: ../../build/mime.types + cp $< $@ + +# ---------------------------------------------------- +# TARGETS FOR PRODUCTION MODE +# ---------------------------------------------------- +$(RELS)/lib: + # For some reason this will not happen if added to PRODUCTION_DIR_STRUCTURE + mkdir $@ + @ erl -pz $(RELS)/build/$(REL_VSN) \ + -noshell \ + -s fs_lib s_apply fs_boot_smithe stage_from_relsrc "[\"$(USR_LIBPATH)\"]. " \ + \"$$(basename `pwd`)".rel.src\". " \ + \"$@\"". " \ + -s init stop + +# Move the htdocs from the local apps to the production htdoc root directory. +$(RELS)/var/$(REL_VSN)/www/htdocs/: $(HTDOCS) + @mkdir -p $(RELS)/var/$(REL_VSN)/www/htdocs; \ + for x in $(HTDOCS);do \ + cp $$x $@; \ + done + +# startup script for production mode +$(RELS)/stage/$(RELS).sh.src: + @echo '#!/bin/sh' > $@ + @echo "cd %INSTALL_DIR%/$(RELS)/release/$(REL_VSN)" >> $@ + @echo "erl -name $(RELS) -boot $(RELS) -config $(RELS).config -detached \$$@" >> $@ + chmod +x $@ + +$(RELS)/build/$(REL_VSN): $(USR_LIBPATH)/fslib/ebin + mkdir -p $(RELS)/build/$(REL_VSN) + cp $ $@ + @echo "" >> $@ + @echo "if [ \$$# -eq 1 ];then" >> $@ + @echo " INSTALL_DIR=\$$1;" >> $@ + @echo "else" >> $@ + @echo " INSTALL_DIR=$(INSTALL_DIR);" >> $@ + @echo "fi" >> $@ + @echo "" >> $@ + @echo "function munge() {" >> $@ + @echo " sed -e \"s;%LOG_OTP%;\$$INSTALL_DIR/$(RELS)/log/$(REL_VSN);g\" \\" >> $@ + @echo " -e \"s;%VAR_OTP%;\$$INSTALL_DIR/$(RELS)/var/$(REL_VSN);g\" \\" >> $@ + @echo " -e \"s;%RELS%;$(RELS);g\" \\" >> $@ + @echo " -e \"s;%REL_VSN%;$(REL_VSN);g\" \\" >> $@ + @echo " -e \"s;%USER%;$$USER;g\" \\" >> $@ + @echo " -e \"s;%HTDOC_ROOT%;\$$INSTALL_DIR/$(RELS)/var/$(REL_VSN)/www/htdocs;g\" \\" >> $@ + @echo " -e \"s;%MHOST%;\`hostname\`;g\" \\" >> $@ + @echo " -e \"s;%BROADCAST_ADDRESS%;$(BROADCAST_ADDRESS);g\" \\" >> $@ + @echo " -e \"s;%INSTALL_DIR%;\$$INSTALL_DIR;g\" \\" >> $@ + @echo " -e \"s;%CONTACT_NODE%;$(CONTACT_NODE);g\" \\" >> $@ + @echo " -e \"s;%HOSTNAME%;\`hostname --long\`;g\" \\" >> $@ + @echo " -e \"s;%APP_NAME%;$(APP_NAME);g\" \\" >> $@ + @echo " -e \"s;%APP_VERSION%;$(APP_VERSION);g\" \\" >> $@ + @echo ' $$1 > $$2' >> $@ + @echo "}" >> $@ + @echo "" >> $@ + @echo "munge stage/yaws.conf.src var/$(REL_VSN)/www/conf/yaws.conf;" >> $@ + @echo "munge stage/$(RELS).config.src release/$(REL_VSN)/$(RELS).config;" >> $@ + @echo "munge stage/$(RELS).sh.src release/$(REL_VSN)/$(RELS).sh;" >> $@ + @echo "munge stage/$(RELS).rel.src release/$(REL_VSN)/$(RELS).rel;" >> $@ + @echo "chmod +x release/$(REL_VSN)/$(RELS).sh;" >> $@ + @echo "" >> $@ + @echo "cd ..;" >> $@ + @echo "find $(RELS) | cpio -o > \$$INSTALL_DIR/$(RELS).cpio;" >> $@ + @echo "cd -;" >> $@ + @echo "cd \$$INSTALL_DIR; " >> $@ + @echo "echo -n \"Unpacked: \"" >> $@ + @echo "cpio -uid < $(RELS).cpio;" >> $@ + @echo "rm $(RELS).cpio;" >> $@ + @echo "" >> $@ + @echo "echo \"pwd is \`pwd\`\";" >> $@ + @echo "cd $(RELS);" >> $@ + @echo " erl -pz build/$(REL_VSN) \\" >> $@ + @echo " -noshell \\" >> $@ + @echo -n " -s fs_lib s_apply fs_boot_smithe make_script_and_boot \"[\\\"$(ERL_RUN_TOP)/*\\\", \\\"lib/\\\"]. \" " >> $@ + @echo -n "\"\\\"stage/$$(basename `pwd`).rel.src\\\". \" " >> $@ + @echo -n "\"[local]. \" " >> $@ + @echo "-s init stop | egrep '*terminate*|ERROR'" >> $@ + @echo "if [ \$$? -eq 0 ]; then" >> $@ + @echo "echo \"============================================\";" >> $@ + @echo "echo \"STAGE FAILURE \$$? - Silence the discord.\";" >> $@ + @echo "echo \"============================================\";" >> $@ + @echo "exit 1;" >> $@ + @echo "fi" >> $@ + @echo "" >> $@ + @echo "mv $(RELS).rel $(RELS).script $(RELS).boot release/$(REL_VSN);" >> $@ + @echo "" >> $@ + @echo "rm -r stage;" >> $@ + @echo "rm -r build;" >> $@ + @echo "cd -;" >> $@ + @echo "" >> $@ + @echo "chgrp -R erts $(RELS); " >> $@ + @echo "chmod -R 775 $(RELS); " >> $@ + @echo "cd -" >> $@ + @echo "" >> $@ + @echo "rm -f /usr/local/bin/$(APP_NAME);" >> $@ + @echo "ln -s \$$INSTALL_DIR/$(RELS)/release/$(REL_VSN)/$(RELS).sh /usr/local/bin/$(APP_NAME);" >> $@ + @echo "chgrp -R erts /usr/local/bin/$(APP_NAME); " >> $@ + @echo "chmod -R 775 /usr/local/bin/$(APP_NAME); " >> $@ + @echo "rm \$$INSTALL_DIR/$(RELS)/install.sh;" >> $@ + @echo "echo -n $$'\e[0;32m'" >> $@ + @echo "echo \"$(APP_NAME) installation to \$$INSTALL_DIR complete.\"" >> $@ + @echo "echo -n $$'\e[0m'" >> $@ + chmod +x $@ + + +stage: $(RELS) + cd $(RELS); \ + ./install.sh; \ + cd - + +$(RELS)/var/$(REL_VSN)/www/conf/mime.types: ../../build/mime.types + cp $< $@ + +$(RELS)-$(LOCATION)-$(REL_VSN).tgz: $(RELS) + tar -zcvf $@ $< + +$(RELS)/release/$(REL_VSN)/clean_release: ../../tools/utilities/clean_release + cp $< $@ + diff --git a/lib/erl/tools/.appgen/blank_app_rel/blank_app_rel.config.src b/lib/erl/tools/.appgen/blank_app_rel/blank_app_rel.config.src new file mode 100755 index 00000000..c701c5a6 --- /dev/null +++ b/lib/erl/tools/.appgen/blank_app_rel/blank_app_rel.config.src @@ -0,0 +1,26 @@ +%%% -*- mode:erlang -*- +%%% Parameter settings for apps on %APP_NAME% +%%% Warning - this config file *must* end with + +%% write log files to sasl_dir +[ + {sasl, + [ + {sasl_error_logger, {file, "%LOG_OTP%/sasl_log"}} + ]}, + + + {gas, + [ + {mod_specs, [{elwrap, {fs_elwrap_h, start_link}}]}, + + % elwrap config. + {err_log, "%LOG_OTP%/err_log"}, + {err_log_wrap_info, {{err,5000000,10},{sasl,5000000,10}}}, + {err_log_tty, true} % Log to the screen + ]}, + + {%APP_NAME%, + [ + ]} +]. diff --git a/lib/erl/tools/.appgen/blank_app_rel/blank_app_rel.rel.src b/lib/erl/tools/.appgen/blank_app_rel/blank_app_rel.rel.src new file mode 100755 index 00000000..f69578ea --- /dev/null +++ b/lib/erl/tools/.appgen/blank_app_rel/blank_app_rel.rel.src @@ -0,0 +1,14 @@ +%%% -*- mode:erlang -*- +{release, + {"%%APP_NAME%%_rel", "%REL_VSN%"}, + erts, + [ + kernel, + stdlib, + sasl, + fslib, + gas, + %%APP_NAME%% + ] +}. + diff --git a/lib/erl/tools/.appgen/blank_app_rel/vsn.mk b/lib/erl/tools/.appgen/blank_app_rel/vsn.mk new file mode 100755 index 00000000..0ac8e073 --- /dev/null +++ b/lib/erl/tools/.appgen/blank_app_rel/vsn.mk @@ -0,0 +1 @@ +REL_VSN=1.0 diff --git a/lib/erl/tools/.appgen/blank_app_rel/yaws.conf.src b/lib/erl/tools/.appgen/blank_app_rel/yaws.conf.src new file mode 100644 index 00000000..8857aac5 --- /dev/null +++ b/lib/erl/tools/.appgen/blank_app_rel/yaws.conf.src @@ -0,0 +1,166 @@ + +# conf for yaws + + +# first we have a set of globals +# That apply to all virtual servers + + +# This is the directory where all logfiles for +# all virtual servers will be written + +logdir = /var/log/yaws + +# This the path to a directory where additional +# beam code can be placed. The daemon will add this +# directory to its search path + +ebin_dir = /var/yaws/ebin + + +# This is a directory where application specific .hrl +# files can be placed. application specifig .yaws code can +# then include these .hrl files + +include_dir = /var/yaws/include + + + + + +# This is a debug variable, possible values are http | traffic | false +# It is also possible to set the trace (possibly to the tty) while +# invoking yaws from the shell as in +# yaws -i -T -x (see man yaws) + +trace = false + + + + + +# it is possible to have yaws start additional +# application specific code at startup +# +# runmod = mymodule + + +# By default yaws will copy the erlang error_log and +# end write it to a wrap log called report.log (in the logdir) +# this feature can be turned off. This would typically +# be the case when yaws runs within another larger app + +copy_error_log = true + + +# Logs are wrap logs + +log_wrap_size = 1000000 + + +# Possibly resolve all hostnames in logfiles so webalizer +# can produce the nice geography piechart + +log_resolve_hostname = false + + + +# fail completely or not if yaws fails +# to bind a listen socket +fail_on_bind_err = true + + + +# If yaws is started as root, it can, once it has opened +# all relevant sockets for listening, change the uid to a +# user with lower accessrights than root + +# username = nobody + + +# If HTTP auth is used, it is possible to have a specific +# auth log. + +auth_log = true + + +# When we're running multiple yaws systems on the same +# host, we need to give each yaws system an individual +# name. Yaws will write a number of runtime files under +# /tmp/yaws/${id} +# The default value is "default" + + +# id = myname + + +# earlier versions of Yaws picked the first virtual host +# in a list of hosts with the same IP/PORT when the Host: +# header doesn't match any name on any Host +# This is often nice in testing environments but not +# acceptable in real live hosting scenarios + +pick_first_virthost_on_nomatch = true + + +# All unices are broken since it's not possible to bind to +# a privileged port (< 1024) unless uid==0 +# There is a contrib in jungerl which makes it possible by means +# of an external setuid root programm called fdsrv to listen to +# to privileged port. +# If we use this feature, it requires fdsrv to be properly installed. +# Doesn't yet work with SSL. + +use_fdsrv = false + + + + +# end then a set of virtual servers +# First two virthosted servers on the same IP (0.0.0.0) +# in this case, but an explicit IP can be given as well + + + port = 80 + listen = 0.0.0.0 + docroot = /var/yaws/www + arg_rewrite_mod = pwr_arg_rewrite_mod + appmods = + + + + port = 80 + listen = 0.0.0.0 + docroot = /tmp + dir_listings = true + dav = true + + realm = foobar + dir = / + user = foo:bar + user = baz:bar + + + + + +# And then an ssl server + + + port = 443 + docroot = /tmp + listen = 0.0.0.0 + dir_listings = true + + keyfile = /usr/local/yaws/etc/yaws-key.pem + certfile = /usr/local/yaws/etc/yaws-cert.pem + + + + + + + + + + diff --git a/lib/erl/tools/.appgen/rename.sh b/lib/erl/tools/.appgen/rename.sh new file mode 100755 index 00000000..6f077c2e --- /dev/null +++ b/lib/erl/tools/.appgen/rename.sh @@ -0,0 +1,25 @@ +#!/bin/sh + +if [ $# -eq 3 ]; then + OLD_PREFIX=$1 + NEW_PREFIX=$2 + FILENAME=$3 + NEW_FILENAME=$(echo $FILENAME | sed -e "s/$OLD_PREFIX/$NEW_PREFIX/") + echo "moving $FILENAME to $NEW_FILENAME" + mv $FILENAME $NEW_FILENAME + exit 0; +fi + + +if [ $# -eq 2 ]; then + while read line; + do + OLD_PREFIX=$1 + NEW_PREFIX=$2 + NEW_FILENAME=$(echo ${line} | sed -e "s/$OLD_PREFIX/$NEW_PREFIX/") + echo "moving ${line} to $NEW_FILENAME" + mv ${line} $NEW_FILENAME + done + exit 0 +fi + diff --git a/lib/erl/tools/.appgen/substitute.sh b/lib/erl/tools/.appgen/substitute.sh new file mode 100755 index 00000000..5305b75e --- /dev/null +++ b/lib/erl/tools/.appgen/substitute.sh @@ -0,0 +1,33 @@ +#!/bin/sh + + +if [ $# -lt 2 ]; then + echo "usage: substitute.sh " + exit 1 +fi + +if [ $# -eq 3 ]; then + VARIABLE=$1 + VALUE=$2 + FILENAME=$3 + + echo "replacing $VARIABLE with $VALUE in $FILENAME" + sed -e "s/$VARIABLE/$VALUE/" $FILENAME > "$FILENAME"_tmp + mv "$FILENAME"_tmp $FILENAME + exit 0 +fi + +if [ $# -eq 2 ]; then + while read line; + do + VARIABLE=$1 + VALUE=$2 + FILENAME=${line} + + echo "replacing $VARIABLE with $VALUE in $FILENAME" + sed -e "s/$VARIABLE/$VALUE/" $FILENAME > "$FILENAME"_tmp + mv "$FILENAME"_tmp $FILENAME + done + exit 0 +fi + diff --git a/lib/erl/tools/.appgen/thrift_rel/Makefile b/lib/erl/tools/.appgen/thrift_rel/Makefile new file mode 100755 index 00000000..5d35956a --- /dev/null +++ b/lib/erl/tools/.appgen/thrift_rel/Makefile @@ -0,0 +1,298 @@ +# ---------------------------------------------------- +# Make file for creating an otp release. +# ---------------------------------------------------- + +## +# Basename of this release. +## +RELS=$(shell basename `pwd`) +APP_NAME=$(shell echo $(RELS) | sed s/_rel$$//) + +include ../../build/otp.mk + +include ./vsn.mk + +#include $(ERL_TOP)/make/target.mk +#include $(ERL_TOP)/make/$(TARGET)/otp.mk + +USR_LIBPATH=../../lib +INSTALL_DIR=/usr/local/lib +ABS_USER_LIBPATH=$(shell cd ../../lib;pwd) + +# ---------------------------------------------------- +# CREATE DIR STRUCTURE HERE +# ---------------------------------------------------- + +HTDOCS=$(wildcard $(ABS_USER_LIBPATH)/$(APP_NAME)/htdocs/*.html) \ + $(wildcard $(ABS_USER_LIBPATH)/$(APP_NAME)/htdocs/*.htm) \ + $(wildcard $(ABS_USER_LIBPATH)/$(APP_NAME)/htdocs/*.yaws) +BUILD_FILES=fs_boot_smithe.beam fs_lists.beam fs_lib.beam + +LOCAL_DIR=local +#LOCAL_DIR=$(shell cat $(RELS).rel.src |grep -m 1 '$(APP_NAME)' |awk -F '"' '{printf "%s-%s", $$2,$$4}') + +DIR_STRUCTURE= \ + $(LOCAL_DIR) \ + $(LOCAL_DIR)/log/$(REL_VSN) \ + $(LOCAL_DIR)/var/$(REL_VSN) \ + $(LOCAL_DIR)/var/$(REL_VSN)/www/conf \ + $(LOCAL_DIR)/var/$(REL_VSN)/www/htdocs + +PRODUCTION_DIR_STRUCTURE= \ + $(RELS) \ + $(RELS)/release/$(REL_VSN) \ + $(RELS)/stage \ + $(RELS)/log/$(REL_VSN) \ + $(RELS)/var/$(REL_VSN) \ + $(RELS)/var/$(REL_VSN)/www \ + $(RELS)/var/$(REL_VSN)/www/htdocs \ + $(RELS)/var/$(REL_VSN)/www/conf + +# ---------------------------------------------------- +SCRIPT_AND_BOOT_FILES= \ + $(RELS).script \ + $(RELS).boot + +LOCAL_SCRIPT_AND_BOOT_FILES= \ + $(LOCAL_DIR)/$(RELS).script \ + $(LOCAL_DIR)/$(RELS).boot + +LOCAL_HTTP_CONF= \ + $(LOCAL_DIR)/var/$(REL_VSN)/www/conf/yaws.conf \ + $(LOCAL_DIR)/var/$(REL_VSN)/www/conf/mime.types + +PRODUCTION_HTTP_CONF= \ + $(LOCAL_DIR)/var/$(REL_VSN)/www/conf/yaws.conf \ + $(LOCAL_DIR)/var/$(REL_VSN)/www/conf/mime.types + +LOCAL_TARGET_FILES=$(LOCAL_HTTP_CONF) $(LOCAL_DIR)/$(RELS).config $(LOCAL_SCRIPT_AND_BOOT_FILES) + +LOCAL_TARGETS=$(LOCAL_DIR)/$(RELS).sh vsnit $(LOCAL_TARGET_FILES) + +PRODUCTION_TARGETS=$(RELS)/build/$(REL_VSN) \ + $(RELS)/lib \ + $(RELS)/stage/$(RELS).rel.src \ + $(RELS)/stage/$(RELS).config.src \ + $(RELS)/stage/yaws.conf.src \ + $(RELS)/stage/$(RELS).sh.src \ + $(RELS)/var/$(REL_VSN)/www/htdocs \ + $(RELS)/install.sh \ + $(RELS)/release/$(REL_VSN)/clean_release + +# ---------------------------------------------------- +# TARGETS +# ---------------------------------------------------- + +all debug opt instr script: $(DIR_STRUCTURE) $(LOCAL_TARGETS) $(PRODUCTION_DIR_STRUCTURE) $(PRODUCTION_TARGETS) + @echo $(HTDOCS) + +install: stage + +tar: $(RELS)-$(LOCATION)-$(REL_VSN).tgz + +$(DIR_STRUCTURE): + mkdir -p $@ + +$(PRODUCTION_DIR_STRUCTURE): + mkdir -p $@ + +clean: + $(RM) $(REL_SCRIPTS) $(TARGET_FILES) + $(RM) -r $(LOCAL_DIR) $(PRODN_DIR) + $(RM) $(RELS).rel + $(RM) -r $(RELS) + $(RM) $(RELS)*.tgz + $(RM) $(RELS).rel.src.tmp + $(RM) $(SCRIPT_AND_BOOT_FILES) + +docs: + +# ---------------------------------------------------- +# TARGETS FOR LOCAL MODE +# ---------------------------------------------------- + +# startup script for local mode +$(LOCAL_DIR)/$(RELS).sh: + @echo '#!/bin/sh' > $@ + @echo "cd $(CURDIR)/$(LOCAL_DIR)" >> $@ + @echo "erl -name $${USER}_$(RELS) -boot $(RELS) -config $(RELS).config \$$@" >> $@ + chmod +x $@ + @echo + @echo "==== Start local node with \"sh $@\" ====" + @echo + +# Create the config file for local mode. +$(LOCAL_DIR)/$(RELS).config: $(RELS).config.src + sed -e 's;%LOG_OTP%;$(CURDIR)/$(LOCAL_DIR)/log/$(REL_VSN);' \ + -e 's;%VAR_OTP%;$(CURDIR)/$(LOCAL_DIR)/var/$(REL_VSN);' \ + -e 's;%RELS%;$(RELS);g' \ + -e 's;%HOME%;$(HOME);g' \ + -e 's;%BROADCAST_ADDRESS%;$(BROADCAST_ADDRESS);g' \ + -e 's;%CONTACT_NODE%;$(CONTACT_NODE);g' \ + -e "s;%HOSTNAME%;`hostname --long`;" \ + -e 's;%APP_NAME%;$(APP_NAME);' \ + -e 's;%APP_VERSION%;$(APP_VERSION);g' \ + $< > $@ + +# Create the httpd conf file for local mode. +$(LOCAL_DIR)/var/$(REL_VSN)/www/conf/yaws.conf: yaws.conf.src + sed -e 's;%VAR_OTP%;$(CURDIR)/$(LOCAL_DIR)/var/$(REL_VSN);' \ + -e 's;%LOG_OTP%;$(CURDIR)/$(LOCAL_DIR)/log/$(REL_VSN);' \ + -e 's;%HTDOC_ROOT%;$(ABS_USER_LIBPATH)/$(APP_NAME)/htdocs;' \ + -e 's;%APP_NAME%;$(APP_NAME);' \ + -e 's;%RELS%;$(RELS);' \ + -e 's;%USER%;$(USER);' \ + -e 's;%HTDOC_ROOT%;$(ABS_USER_LIBPATH);' \ + -e 's;%MHOST%;$(MHOST);' \ + $< > $@ + +# Create the config file for local mode. +vsnit: $(RELS).rel.src + sed -e 's;%REL_VSN%;$(REL_VSN);' \ + $< > $<.tmp + +# Create and position script and boot files for local mode. +$(LOCAL_SCRIPT_AND_BOOT_FILES): + @ erl -pz $(USR_LIBPATH)/fslib/ebin \ + -noshell \ + -s fs_lib s_apply fs_boot_smithe make_script_and_boot "[\"$(ERL_RUN_TOP)/*\", \"$(USR_LIBPATH)\"]. " \ + \"$$(basename `pwd`)".rel.src.tmp\". " \ + "[local]. " \ + -s init stop + cp $(SCRIPT_AND_BOOT_FILES) $(LOCAL_DIR)/ + +$(LOCAL_DIR)/var/$(REL_VSN)/www/conf/mime.types: ../../build/mime.types + cp $< $@ + +# ---------------------------------------------------- +# TARGETS FOR PRODUCTION MODE +# ---------------------------------------------------- +$(RELS)/lib: + # For some reason this will not happen if added to PRODUCTION_DIR_STRUCTURE + mkdir $@ + @ erl -pz $(RELS)/build/$(REL_VSN) \ + -noshell \ + -s fs_lib s_apply fs_boot_smithe stage_from_relsrc "[\"$(USR_LIBPATH)\"]. " \ + \"$$(basename `pwd`)".rel.src\". " \ + \"$@\"". " \ + -s init stop + +# Move the htdocs from the local apps to the production htdoc root directory. +$(RELS)/var/$(REL_VSN)/www/htdocs/: $(HTDOCS) + @mkdir -p $(RELS)/var/$(REL_VSN)/www/htdocs; \ + for x in $(HTDOCS);do \ + cp $$x $@; \ + done + +# startup script for production mode +$(RELS)/stage/$(RELS).sh.src: + @echo '#!/bin/sh' > $@ + @echo "cd %INSTALL_DIR%/$(RELS)/release/$(REL_VSN)" >> $@ + @echo "erl -name $(RELS) -boot $(RELS) -config $(RELS).config -detached \$$@" >> $@ + chmod +x $@ + +$(RELS)/build/$(REL_VSN): $(USR_LIBPATH)/fslib/ebin + mkdir -p $(RELS)/build/$(REL_VSN) + cp $ $@ + @echo "" >> $@ + @echo "if [ \$$# -eq 1 ];then" >> $@ + @echo " INSTALL_DIR=\$$1;" >> $@ + @echo "else" >> $@ + @echo " INSTALL_DIR=$(INSTALL_DIR);" >> $@ + @echo "fi" >> $@ + @echo "" >> $@ + @echo "function munge() {" >> $@ + @echo " sed -e \"s;%LOG_OTP%;\$$INSTALL_DIR/$(RELS)/log/$(REL_VSN);g\" \\" >> $@ + @echo " -e \"s;%VAR_OTP%;\$$INSTALL_DIR/$(RELS)/var/$(REL_VSN);g\" \\" >> $@ + @echo " -e \"s;%RELS%;$(RELS);g\" \\" >> $@ + @echo " -e \"s;%REL_VSN%;$(REL_VSN);g\" \\" >> $@ + @echo " -e \"s;%USER%;$$USER;g\" \\" >> $@ + @echo " -e \"s;%HTDOC_ROOT%;\$$INSTALL_DIR/$(RELS)/var/$(REL_VSN)/www/htdocs;g\" \\" >> $@ + @echo " -e \"s;%MHOST%;\`hostname\`;g\" \\" >> $@ + @echo " -e \"s;%BROADCAST_ADDRESS%;$(BROADCAST_ADDRESS);g\" \\" >> $@ + @echo " -e \"s;%INSTALL_DIR%;\$$INSTALL_DIR;g\" \\" >> $@ + @echo " -e \"s;%CONTACT_NODE%;$(CONTACT_NODE);g\" \\" >> $@ + @echo " -e \"s;%HOSTNAME%;\`hostname --long\`;g\" \\" >> $@ + @echo " -e \"s;%APP_NAME%;$(APP_NAME);g\" \\" >> $@ + @echo " -e \"s;%APP_VERSION%;$(APP_VERSION);g\" \\" >> $@ + @echo ' $$1 > $$2' >> $@ + @echo "}" >> $@ + @echo "" >> $@ + @echo "munge stage/yaws.conf.src var/$(REL_VSN)/www/conf/yaws.conf;" >> $@ + @echo "munge stage/$(RELS).config.src release/$(REL_VSN)/$(RELS).config;" >> $@ + @echo "munge stage/$(RELS).sh.src release/$(REL_VSN)/$(RELS).sh;" >> $@ + @echo "munge stage/$(RELS).rel.src release/$(REL_VSN)/$(RELS).rel;" >> $@ + @echo "chmod +x release/$(REL_VSN)/$(RELS).sh;" >> $@ + @echo "" >> $@ + @echo "cd ..;" >> $@ + @echo "find $(RELS) | cpio -o > \$$INSTALL_DIR/$(RELS).cpio;" >> $@ + @echo "cd -;" >> $@ + @echo "cd \$$INSTALL_DIR; " >> $@ + @echo "echo -n \"Unpacked: \"" >> $@ + @echo "cpio -uid < $(RELS).cpio;" >> $@ + @echo "rm $(RELS).cpio;" >> $@ + @echo "" >> $@ + @echo "echo \"pwd is \`pwd\`\";" >> $@ + @echo "cd $(RELS);" >> $@ + @echo " erl -pz build/$(REL_VSN) \\" >> $@ + @echo " -noshell \\" >> $@ + @echo -n " -s fs_lib s_apply fs_boot_smithe make_script_and_boot \"[\\\"$(ERL_RUN_TOP)/*\\\", \\\"lib/\\\"]. \" " >> $@ + @echo -n "\"\\\"stage/$$(basename `pwd`).rel.src\\\". \" " >> $@ + @echo -n "\"[local]. \" " >> $@ + @echo "-s init stop | egrep '*terminate*|ERROR'" >> $@ + @echo "if [ \$$? -eq 0 ]; then" >> $@ + @echo "echo \"============================================\";" >> $@ + @echo "echo \"STAGE FAILURE \$$? - Silence the discord.\";" >> $@ + @echo "echo \"============================================\";" >> $@ + @echo "exit 1;" >> $@ + @echo "fi" >> $@ + @echo "" >> $@ + @echo "mv $(RELS).rel $(RELS).script $(RELS).boot release/$(REL_VSN);" >> $@ + @echo "" >> $@ + @echo "rm -r stage;" >> $@ + @echo "rm -r build;" >> $@ + @echo "cd -;" >> $@ + @echo "" >> $@ + @echo "chgrp -R erts $(RELS); " >> $@ + @echo "chmod -R 775 $(RELS); " >> $@ + @echo "cd -" >> $@ + @echo "" >> $@ + @echo "rm -f /usr/local/bin/$(APP_NAME);" >> $@ + @echo "ln -s \$$INSTALL_DIR/$(RELS)/release/$(REL_VSN)/$(RELS).sh /usr/local/bin/$(APP_NAME);" >> $@ + @echo "chgrp -R erts /usr/local/bin/$(APP_NAME); " >> $@ + @echo "chmod -R 775 /usr/local/bin/$(APP_NAME); " >> $@ + @echo "rm \$$INSTALL_DIR/$(RELS)/install.sh;" >> $@ + @echo "echo -n $$'\e[0;32m'" >> $@ + @echo "echo \"$(APP_NAME) installation to \$$INSTALL_DIR complete.\"" >> $@ + @echo "echo -n $$'\e[0m'" >> $@ + chmod +x $@ + + +stage: $(RELS) + cd $(RELS); \ + ./install.sh; \ + cd - + +$(RELS)/var/$(REL_VSN)/www/conf/mime.types: ../../build/mime.types + cp $< $@ + +$(RELS)-$(LOCATION)-$(REL_VSN).tgz: $(RELS) + tar -zcvf $@ $< + +$(RELS)/release/$(REL_VSN)/clean_release: ../../tools/utilities/clean_release + cp $< $@ + diff --git a/lib/erl/tools/.appgen/thrift_rel/thrift_rel.config.src b/lib/erl/tools/.appgen/thrift_rel/thrift_rel.config.src new file mode 100755 index 00000000..c701c5a6 --- /dev/null +++ b/lib/erl/tools/.appgen/thrift_rel/thrift_rel.config.src @@ -0,0 +1,26 @@ +%%% -*- mode:erlang -*- +%%% Parameter settings for apps on %APP_NAME% +%%% Warning - this config file *must* end with + +%% write log files to sasl_dir +[ + {sasl, + [ + {sasl_error_logger, {file, "%LOG_OTP%/sasl_log"}} + ]}, + + + {gas, + [ + {mod_specs, [{elwrap, {fs_elwrap_h, start_link}}]}, + + % elwrap config. + {err_log, "%LOG_OTP%/err_log"}, + {err_log_wrap_info, {{err,5000000,10},{sasl,5000000,10}}}, + {err_log_tty, true} % Log to the screen + ]}, + + {%APP_NAME%, + [ + ]} +]. diff --git a/lib/erl/tools/.appgen/thrift_rel/thrift_rel.rel.src b/lib/erl/tools/.appgen/thrift_rel/thrift_rel.rel.src new file mode 100644 index 00000000..a11d2405 --- /dev/null +++ b/lib/erl/tools/.appgen/thrift_rel/thrift_rel.rel.src @@ -0,0 +1,14 @@ +%%% -*- mode:erlang -*- +{release, + {"thrift_rel", "%REL_VSN%"}, + erts, + [ + kernel, + stdlib, + sasl, + fslib, + gas, + thrift + ] +}. + diff --git a/lib/erl/tools/.appgen/thrift_rel/vsn.mk b/lib/erl/tools/.appgen/thrift_rel/vsn.mk new file mode 100755 index 00000000..0ac8e073 --- /dev/null +++ b/lib/erl/tools/.appgen/thrift_rel/vsn.mk @@ -0,0 +1 @@ +REL_VSN=1.0 diff --git a/lib/erl/tools/.appgen/thrift_rel/yaws.conf.src b/lib/erl/tools/.appgen/thrift_rel/yaws.conf.src new file mode 100644 index 00000000..8857aac5 --- /dev/null +++ b/lib/erl/tools/.appgen/thrift_rel/yaws.conf.src @@ -0,0 +1,166 @@ + +# conf for yaws + + +# first we have a set of globals +# That apply to all virtual servers + + +# This is the directory where all logfiles for +# all virtual servers will be written + +logdir = /var/log/yaws + +# This the path to a directory where additional +# beam code can be placed. The daemon will add this +# directory to its search path + +ebin_dir = /var/yaws/ebin + + +# This is a directory where application specific .hrl +# files can be placed. application specifig .yaws code can +# then include these .hrl files + +include_dir = /var/yaws/include + + + + + +# This is a debug variable, possible values are http | traffic | false +# It is also possible to set the trace (possibly to the tty) while +# invoking yaws from the shell as in +# yaws -i -T -x (see man yaws) + +trace = false + + + + + +# it is possible to have yaws start additional +# application specific code at startup +# +# runmod = mymodule + + +# By default yaws will copy the erlang error_log and +# end write it to a wrap log called report.log (in the logdir) +# this feature can be turned off. This would typically +# be the case when yaws runs within another larger app + +copy_error_log = true + + +# Logs are wrap logs + +log_wrap_size = 1000000 + + +# Possibly resolve all hostnames in logfiles so webalizer +# can produce the nice geography piechart + +log_resolve_hostname = false + + + +# fail completely or not if yaws fails +# to bind a listen socket +fail_on_bind_err = true + + + +# If yaws is started as root, it can, once it has opened +# all relevant sockets for listening, change the uid to a +# user with lower accessrights than root + +# username = nobody + + +# If HTTP auth is used, it is possible to have a specific +# auth log. + +auth_log = true + + +# When we're running multiple yaws systems on the same +# host, we need to give each yaws system an individual +# name. Yaws will write a number of runtime files under +# /tmp/yaws/${id} +# The default value is "default" + + +# id = myname + + +# earlier versions of Yaws picked the first virtual host +# in a list of hosts with the same IP/PORT when the Host: +# header doesn't match any name on any Host +# This is often nice in testing environments but not +# acceptable in real live hosting scenarios + +pick_first_virthost_on_nomatch = true + + +# All unices are broken since it's not possible to bind to +# a privileged port (< 1024) unless uid==0 +# There is a contrib in jungerl which makes it possible by means +# of an external setuid root programm called fdsrv to listen to +# to privileged port. +# If we use this feature, it requires fdsrv to be properly installed. +# Doesn't yet work with SSL. + +use_fdsrv = false + + + + +# end then a set of virtual servers +# First two virthosted servers on the same IP (0.0.0.0) +# in this case, but an explicit IP can be given as well + + + port = 80 + listen = 0.0.0.0 + docroot = /var/yaws/www + arg_rewrite_mod = pwr_arg_rewrite_mod + appmods = + + + + port = 80 + listen = 0.0.0.0 + docroot = /tmp + dir_listings = true + dav = true + + realm = foobar + dir = / + user = foo:bar + user = baz:bar + + + + + +# And then an ssl server + + + port = 443 + docroot = /tmp + listen = 0.0.0.0 + dir_listings = true + + keyfile = /usr/local/yaws/etc/yaws-key.pem + certfile = /usr/local/yaws/etc/yaws-cert.pem + + + + + + + + + + diff --git a/lib/erl/tools/emacs/erlang-start.el b/lib/erl/tools/emacs/erlang-start.el new file mode 100755 index 00000000..5181b9a1 --- /dev/null +++ b/lib/erl/tools/emacs/erlang-start.el @@ -0,0 +1,115 @@ +;; erlang-start.el --- Load this file to initialize the Erlang package. + +;; Copyright (C) 1998 Ericsson Telecom AB + +;; Author: Anders Lindgren +;; Version: 2.3 +;; Keywords: erlang, languages, processes +;; Created: 1996-09-18 +;; Date: 1998-03-16 + +;;; Commentary: + +;; Introduction: +;; ------------ +;; +;; This package provides support for the programming language Erlang. +;; The package provides an editing mode with lots of bells and +;; whistles, compilation support, and it makes it possible for the +;; user to start Erlang shells that run inside Emacs. +;; +;; See the Erlang distribution for full documentation of this package. + +;; Installation: +;; ------------ +;; +;; Place this file in Emacs load path, byte-compile it, and add the +;; following line to the appropriate init file: +;; +;; (require 'erlang-start) +;; +;; The full documentation contains much more extensive description of +;; the installation procedure. + +;; Reporting Bugs: +;; -------------- +;; +;; Please send bug reports to the following email address: +;; support@erlang.ericsson.se +;; +;; Please state as exactly as possible: +;; - Version number of Erlang Mode (see the menu), Emacs, Erlang, +;; and of any other relevant software. +;; - What the expected result was. +;; - What you did, preferably in a repeatable step-by-step form. +;; - A description of the unexpected result. +;; - Relevant pieces of Erlang code causing the problem. +;; - Personal Emacs customisations, if any. +;; +;; Should the Emacs generate an error, please set the emacs variable +;; `debug-on-error' to `t'. Repeat the error and enclose the debug +;; information in your bug-report. +;; +;; To set the variable you can use the following command: +;; M-x set-variable RET debug-on-error RET t RET +;;; Code: + +;; +;; Declare functions in "erlang.el". +;; + +(autoload 'erlang-mode "erlang" "Major mode for editing Erlang code." t) +(autoload 'erlang-version "erlang" + "Return the current version of Erlang mode." t) +(autoload 'erlang-shell "erlang" "Start a new Erlang shell." t) +(autoload 'run-erlang "erlang" "Start a new Erlang shell." t) + +(autoload 'erlang-compile "erlang" + "Compile Erlang module in current buffer." t) + +(autoload 'erlang-man-module "erlang" + "Find manual page for MODULE." t) +(autoload 'erlang-man-function "erlang" + "Find manual page for NAME, where NAME is module:function." t) + +(autoload 'erlang-find-tag "erlang" + "Like `find-tag'. Capable of retreiving Erlang modules.") +(autoload 'erlang-find-tag-other-window "erlang" + "Like `find-tag-other-window'. Capable of retreiving Erlang modules.") + + +;; +;; Associate files extensions ".erl" and ".hrl" with Erlang mode. +;; + +(let ((a '("\\.erl\\'" . erlang-mode)) + (b '("\\.hrl\\'" . erlang-mode))) + (or (assoc (car a) auto-mode-alist) + (setq auto-mode-alist (cons a auto-mode-alist))) + (or (assoc (car b) auto-mode-alist) + (setq auto-mode-alist (cons b auto-mode-alist)))) + + +;; +;; Ignore files ending in ".jam", ".vee", and ".beam" when performing +;; file completion. +;; + +(let ((erl-ext '(".jam" ".vee" ".beam"))) + (while erl-ext + (let ((cie completion-ignored-extensions)) + (while (and cie (not (string-equal (car cie) (car erl-ext)))) + (setq cie (cdr cie))) + (if (null cie) + (setq completion-ignored-extensions + (cons (car erl-ext) completion-ignored-extensions)))) + (setq erl-ext (cdr erl-ext)))) + + +;; +;; The end. +;; + +(provide 'erlang-start) + +;; erlang-start.el ends here. diff --git a/lib/erl/tools/emacs/erlang.el b/lib/erl/tools/emacs/erlang.el new file mode 100755 index 00000000..5916f73f --- /dev/null +++ b/lib/erl/tools/emacs/erlang.el @@ -0,0 +1,6291 @@ +;; $Id: erlang.el,v 1.21 2004/08/03 20:38:43 mlogan Exp $ +;; erlang.el --- Major modes for editing and running Erlang + +;; Copyright (C) 1995-1998,2000 Ericsson Telecom AB + +;; Author: Anders Lindgren +;; Version: 2.4 +;; Keywords: erlang, languages, processes +;; Date: 2000-09-11 + +;; Lars Thorsén's modifications of 2000-06-07 included. + +;; The original version of this package was written by Robert Virding. +;; +;; Most skeletons has been written at Ericsson Telecom by +;; magnus@erix.ericsson.se and janne@erix.ericsson.se + +;;; Commentary: + +;; Introduction: +;; ------------ +;; +;; This package provides support for the programming language Erlang. +;; The package provides an editing mode with lots of bells and +;; whistles, compilation support, and it makes it possible for the +;; user to start Erlang shells that run inside Emacs. +;; +;; See the Erlang distribution for full documentation of this package. + +;; Installation: +;; ------------ +;; +;; Place this file in Emacs load path, byte-compile it, and add the +;; following line to the appropriate init file: +;; +;; (require 'erlang-start) +;; +;; The full documentation contains much more extensive description of +;; the installation procedure. + +;; Reporting Bugs: +;; -------------- +;; +;; Please send bug reports to the following email address: +;; support@erlang.ericsson.se +;; +;; Please state as exactly as possible: +;; - Version number of Erlang Mode (see the menu), Emacs, Erlang, +;; and of any other relevant software. +;; - What the expected result was. +;; - What you did, preferably in a repeatable step-by-step form. +;; - A description of the unexpected result. +;; - Relevant pieces of Erlang code causing the problem. +;; - Personal Emacs customisations, if any. +;; +;; Should the Emacs generate an error, please set the emacs variable +;; `debug-on-error' to `t'. Repeat the error and enclose the debug +;; information in your bug-report. +;; +;; To set the variable you can use the following command: +;; M-x set-variable RET debug-on-error RET t RET + +;;; Code: + +;; Variables: + +(defconst erlang-version "2.4" + "The version number of Erlang mode.") + +(defvar erlang-root-dir nil + "The directory where the Erlang system is installed. +The name should not contain the ending slash. + +Should this variable be nil, no manual pages will show up in the +Erlang mode menu.") + +(defvar erlang-menu-items '(erlang-menu-base-items + erlang-menu-skel-items + erlang-menu-shell-items + erlang-menu-compile-items + erlang-menu-man-items + erlang-menu-personal-items + erlang-menu-version-items) + "*List of menu item list to combine to create Erland mode menu. + +External programs which temporary adds menu items to the Erland mode +menu use this variable. Please use the function `add-hook' to add +items. + +Please call the function `erlang-menu-init' after every change to this +variable.") + +(defvar erlang-menu-base-items + '(("Indent" + (("Indent Line" erlang-indent-command) + ("Indent Region " erlang-indent-region + (if erlang-xemacs-p (mark) mark-active)) + ("Indent Clause" erlang-indent-clause) + ("Indent Function" erlang-indent-function) + ("Indent Buffer" erlang-indent-current-buffer))) + ("Edit" + (("Fill Comment" erlang-fill-paragraph) + ("Comment Region" comment-region + (if erlang-xemacs-p (mark) mark-active)) + ("Uncomment Region" erlang-uncomment-region + (if erlang-xemacs-p (mark) mark-active)) + nil + ("Beginning of Function" erlang-beginning-of-function) + ("End of Function" erlang-end-of-function) + ("Mark Function" erlang-mark-function) + nil + ("Beginning of Clause" erlang-beginning-of-clause) + ("End of Clause" erlang-end-of-clause) + ("Mark Clause" erlang-mark-clause) + nil + ("New Clause" erlang-generate-new-clause) + ("Clone Arguments" erlang-clone-arguments))) + ("Syntax Highlighting" + (("Level 3" erlang-font-lock-level-3) + ("Level 2" erlang-font-lock-level-2) + ("Level 1" erlang-font-lock-level-1) + ("Off" erlang-font-lock-level-0))) + ("TAGS" + (("Find Tag" find-tag) + ("Find Next Tag" erlang-find-next-tag) + ;("Find Regexp" find-tag-regexp) + ("Complete Word" erlang-complete-tag) + ("Tags Apropos" tags-apropos) + ("Search Files" tags-search)))) + "*Description of menu used in Erlang mode. + +This variable must be a list. The elements are either nil representing +a horisontal line or a list with two or three elements. The first is +the name of the menu item, the second is the function to call, or a +submenu, on the same same form as ITEMS. The third optional argument +is an expression which is evaluated every time the menu is displayed. +Should the expression evaluate to nil the menu item is ghosted. + +Example: + '((\"Func1\" function-one) + (\"SubItem\" + ((\"Yellow\" function-yellow) + (\"Blue\" function-blue))) + nil + (\"Region Funtion\" spook-function midnight-variable)) + +Call the function `erlang-menu-init' after modifying this variable.") + +(defvar erlang-menu-shell-items + '(nil + ("Shell" + (("Start New Shell" erlang-shell) + ("Display Shell" erlang-shell-display)))) + "*Description of the Shell menu used by Erlang mode. + +Please see the documentation of `erlang-menu-base-items'.") + +(defvar erlang-menu-compile-items + '(("Compile" + (("Compile Buffer" erlang-compile) + ("Display Result" erlang-compile-display) + ("Next Error" erlang-next-error)))) + "*Description of the Compile menu used by Erlang mode. + +Please see the documentation of `erlang-menu-base-items'.") + +(defvar erlang-menu-version-items + '(nil + ("Version" erlang-version)) + "*Description of the version menu used in Erlang mode.") + +(defvar erlang-menu-personal-items nil + "*Description of personal menu items used in Erlang mode. + +Please see the variable `erlang-menu-base-items' for a description +of the format.") + +(defvar erlang-menu-man-items nil + "The menu containing man pages. + +The format of the menu should be compatible with `erlang-menu-base-items'. +This variable is added to the list of Erlang menus stored in +`erlang-menu-items'.") + +(defvar erlang-menu-skel-items '() + "Description of the menu containing the skeleton entries. +The menu is in the form described by the variable `erlang-menu-base-items'.") + +(defvar erlang-mode-hook nil + "*Functions to run when Erlang mode is activated. + +This hook is used to change the behaviour of Erlang mode. It is +normally used by the user to personalise the programming environment. +When used in a site init file, it could be used to customise Erlang +mode for all users on the system. + +The functions added to this hook is runed every time Erlang mode is +started. See also `erlang-load-hook', a hook which is runed once, +when Erlang mode is loaded into Emacs, and `erlang-shell-mode-hook' +which is run every time a new inferior Erlang shell is started. + +To use a hook, create an Emacs lisp function to perform your actions +and add the function to the hook by calling `add-hook'. + +The following example binds the key sequence C-c C-c to the command +`erlang-compile' (normally bound to C-c C-k). The example also +activates Font Lock mode to fontify the buffer and adds a menu +containing all functions defined in the current buffer. + +To use the example, copy the following lines to your `~/.emacs' file: + + (add-hook 'erlang-mode-hook 'my-erlang-mode-hook) + + (defun my-erlang-mode-hook () + (local-set-key \"\\C-c\\C-c\" 'erlang-compile) + (if window-system + (progn + (setq font-lock-maximum-decoration t) + (font-lock-mode 1))) + (if (and window-system (fboundp 'imenu-add-to-menubar)) + (imenu-add-to-menubar \"Imenu\")))") + +(defvar erlang-load-hook nil + "*Functions to run when Erlang mode is loaded. + +This hook is used to change the behaviour of Erlang mode. It is +normally used by the user to personalise the programming environment. +When used in a site init file, it could be used to customize Erlang +mode for all users on the system. + +The difference between this hook and `erlang-mode-hook' and +`erlang-shell-mode-hook' is that the functions in this hook +is only called once, when the Erlang mode is loaded into Emacs +the first time. + +Natural actions for the functions added to this hook are actions which +only should be performed once, and actions which should be performed +before starting Erlang mode. For example, a number of variables are +used by Erlang mode before `erlang-mode-hook' is runed. + +The following example sets the variable `erlang-root-dir' so that the +manual pages can be retrieved (note that you must set the value of +`erlang-root-dir' to match the loation of Erlang on your system): + + (add-hook 'erlang-load-hook 'my-erlang-load-hook) + + (defun my-erlang-load-hook () + (setq erlang-root-dir \"/usr/local/erlang\"))") + +(defvar erlang-new-file-hook nil + "Functions to run when a new Erlang source file is being edited. + +A useful function is `tempo-template-erlang-normal-header'. +\(This function only exists when the `tempo' packags is available.)") + +(defvar erlang-check-module-name 'ask + "*Non-nil means check that module name and file name agrees when saving. + +If the value of this variable is the atom `ask', the user is +prompted. If the value is t the source is silently changed.") + +(defvar erlang-electric-commands + '(erlang-electric-comma + erlang-electric-semicolon + erlang-electric-gt) + "*List of activated electric commands. + +The list should contain the electric commands which should be active. +Currently, the available electric commands are: + erlang-electric-comma + erlang-electric-semicolon + erlang-electric-gt + erlang-electric-newline + +Should the variable be bound to t, all electric commands +are activated. + +To deactivate all electric commands, set this variable to nil.") + +(defvar erlang-electric-newline-inhibit t + "*Set to non-nil to inhibit newline after electric command. + +This is useful since a lot of people press return after executing an +electric command. + +In order to work, the command must also be in the +list `erlang-electric-newline-inhibit-list'. + +Note that commands in this list are required to set the variable +`erlang-electric-newline-inhibit' to nil when the newline shouldn't be +inhibited.") + +(defvar erlang-electric-newline-inhibit-list + '(erlang-electric-semicolon + erlang-electric-comma + erlang-electric-gt) + "*Command which can inhibit the next newline.") + +(defvar erlang-electric-semicolon-insert-blank-lines nil + "*Number of blank lines inserted before header, or nil. + +This variable controls the behaviour of `erlang-electric-semicolon' +when a new function header is generated. When nil, no blank line is +inserted between the current line and the new header. When bound to a +number it represents the number of blank lines which should be +inserted.") + +(defvar erlang-electric-semicolon-criteria + '(erlang-next-lines-empty-p + erlang-at-keyword-end-p + erlang-at-end-of-function-p) + "*List of functions controlling `erlang-electric-semicolon'. +The functions in this list are called, in order, whenever a semicolon +is typed. Each function in the list is called with no arguments, +and should return one of the following values: + + nil -- no determination made, continue checking + 'stop -- do not create prototype for next line + (anything else) -- insert prototype, and stop checking + +If every function in the list is called with no determination made, +then no prototype is inserted. + +The test is performed by the function `erlang-test-criteria-list'.") + +(defvar erlang-electric-comma-criteria + '(erlang-stop-when-inside-argument-list + erlang-stop-when-at-guard + erlang-next-lines-empty-p + erlang-at-keyword-end-p + erlang-at-end-of-function-p) + "*List of functions controlling `erlang-electric-comma'. +The functions in this list are called, in order, whenever a comma +is typed. Each function in the list is called with no arguments, +and should return one of the following values: + + nil -- no determination made, continue checking + 'stop -- do not create prototype for next line + (anything else) -- insert prototype, and stop checking + +If every function in the list is called with no determination made, +then no prototype is inserted. + +The test is performed by the function `erlang-test-criteria-list'.") + +(defvar erlang-electric-arrow-criteria + '(erlang-next-lines-empty-p + erlang-at-end-of-function-p) + "*List of functions controlling the arrow aspect of `erlang-electric-gt'. +The functions in this list are called, in order, whenever a `>' +is typed. Each function in the list is called with no arguments, +and should return one of the following values: + + nil -- no determination made, continue checking + 'stop -- do not create prototype for next line + (anything else) -- insert prototype, and stop checking + +If every function in the list is called with no determination made, +then no prototype is inserted. + +The test is performed by the function `erlang-test-criteria-list'.") + +(defvar erlang-electric-newline-criteria + '(t) + "*List of functions controlling `erlang-electric-newline'. + +The electric newline commands indents the next line. Should the +current line begin with a comment the comment start is copied to +the newly created line. + +The functions in this list are called, in order, whenever a comma +is typed. Each function in the list is called with no arguments, +and should return one of the following values: + + nil -- no determination made, continue checking + 'stop -- do not create prototype for next line + (anything else) -- trigger the electric command. + +If every function in the list is called with no determination made, +then no prototype is inserted. Should the atom t be a member of the +list, it is treated as a function triggering the electric command. + +The test is performed by the function `erlang-test-criteria-list'.") + +(defvar erlang-next-lines-empty-threshold 2 + "*Number of blank lines required to activate an electric command. + +Actually, this value controls the behaviour of the function +`erlang-next-lines-empty-p' which normally is a member of the +criteria lists controlling the electric commands. (Please see +the variables `erlang-electric-semicolon-criteria' and +`erlang-electric-comma-criteria'.) + +The variable is bound to a threshold value, a number, representing the +number of lines which must be empty. + +Setting this variable to zero, electric commands will always be +triggered by `erlang-next-lines-empty-p', unless inhibited by other +rules. + +Should this variable be `nil', `erlang-next-lines-empty-p' will never +trigger an electric command. The same effect would be reached if the +function `erlang-next-lines-empty-p' would be removed from the criteria +lists. + +Note that even if `erlang-next-lines-empty-p' should not trigger an +electric command, other functions in the criteria list could.") + +(defvar erlang-new-clause-with-arguments nil + "*Non-nil means that the arguments are cloned when a clause is generated. + +A new function header can be generated by calls to the function +`erlang-generate-new-clause' and by use of the electric semicolon.") + +(defvar erlang-compile-use-outdir t + "*When nil, go to the directory containing source file when compiling. + +This is a workaround for a bug in the `outdir' option of compile. If the +outdir is not in the current load path, Erlang doesn't load the object +module after it has been compiled. + +To activate the workaround, place the following in your `~/.emacs' file: + (setq erlang-compile-use-outdir nil)") + +(defvar erlang-indent-level 4 + "*Indentation of Erlang calls/clauses within blocks.") + +(defvar erlang-indent-guard 2 + "*Indentation of Erlang guards.") + +(defvar erlang-argument-indent 2 + "*Indentation of the first argument in a function call. +When nil, indent to the column after the `(' of the +function.") + +(defvar erlang-tab-always-indent t + "*Non-nil means TAB in Erlang mode should always reindent the current line, +regardless of where in the line point is when the TAB command is used.") + +(defvar erlang-error-regexp-alist + '(("^\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" . (1 2))) + "*Patterns for matching Erlang errors.") + +(defvar erlang-man-inhibit (eq system-type 'windows-nt) + "Inhibit the creation of the Erlang Manual Pages menu. + +The Windows distribution of Erlang does not include man pages, hence +there is no idea to create the menu.") + +(defvar erlang-man-dirs + '(("Man - Commands" "/man/man1" t) + ("Man - Modules" "/man/man3" t) + ("Man - Unsupported" "/uc/man/man3" t)) + "*The man directories displayed in the Erlang menu. + +Each item in the list should be a list with three elements, the first +the name of the menu, the second the directory, and the last a flag. +Should the flag the nil, the directory is absolute, should it be non-nil +the directory is relative to the variable `erlang-root-dir'.") + +(defvar erlang-man-max-menu-size 20 + "*The maximum number of menu items in one menu allowed.") + +(defvar erlang-man-display-function 'erlang-man-display + "*Function used to display man page. + +The function is called with one argument, the name of the file +containing the man page. Use this variable when the default +function, erlang-man-display, does not work on your system.") + +(defconst erlang-atom-regexp "\\([a-z][a-zA-Z0-9_]*\\|'[^\n']*[^\\]'\\)" + "Regexp which should match an Erlang atom. + +The regexp must be surrounded with a pair of regexp parentheses.") +(defconst erlang-atom-regexp-matches 1 + "Number of regexp parenthesis pairs in `erlang-atom-regexp'. + +This is used to determine parenthesis matches in complex regexps which +contains `erlang-atom-regexp'.") + +(defconst erlang-variable-regexp "\\([A-Z_][a-zA-Z0-9_]*\\)" + "Regexp which should match an Erlang variable. + +The regexp must be surrounded with a pair of regexp parenthesis.") +(defconst erlang-variable-regexp-matches 1 + "Number of regexp parenthesis pairs in `erlang-variable-regexp'. + +This is used to determine matches in complex rexeps which contains +`erlang-variable-regexp'.") + +(defvar erlang-defun-prompt-regexp (concat "^" erlang-atom-regexp "\\s *(") + "*Regexp which should match beginning of a clause.") + +(defvar erlang-file-name-extension-regexp "\\.[eh]rl$" + "*Regexp which should match an erlang file name. + +This regexp is used when an Erlang module name is extracted from the +name of an Erlang source file. + +The regexp should only match the section of the file name which should +be excluded from the module name. + +To match all files set this variable to \"\\\\(\\\\..*\\\\|\\\\)$\". +The matches all except the extension. This is useful if the Erlang +tags system should interpretate tags on the form `module:tag' for +files written in other languages than Erlang.") + +(defvar erlang-mode-map nil + "*Keymap used in Erlang mode.") +(defvar erlang-mode-abbrev-table nil + "Abbrev table in use in Erlang-mode buffers.") +(defvar erlang-mode-syntax-table nil + "Syntax table in use in Erlang-mode buffers.") + +(defconst erlang-emacs-major-version + (if (boundp 'emacs-major-version) + emacs-major-version + (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version) + (string-to-int (substring emacs-version + (match-beginning 1) (match-end 1)))) + "Major version number of Emacs.") + +(defconst erlang-emacs-minor-version + (if (boundp 'emacs-minor-version) + emacs-minor-version + (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version) + (string-to-int (substring emacs-version + (match-beginning 2) (match-end 2)))) + "Minor version number of Emacs.") + +(defconst erlang-xemacs-p (string-match "Lucid\\|XEmacs" emacs-version) + "Non-nil when running under XEmacs or Lucid Emacs.") + +(defvar erlang-xemacs-popup-menu '("Erlang Mode Commands" . nil) + "Common popup menu for all buffers in Erlang mode. + +This variable is destructively modified every time the Erlang menu +is modified. The effect is that all changes take effekt in all +buffers in Erlang mode, just like under GNU Emacs. + +Never EVER set this variable!") + + +;; Tempo skeleton templates: + +(defvar erlang-skel + '(("If" "if" erlang-skel-if) + ("Case" "case" erlang-skel-case) + ("Receive" "receive" erlang-skel-receive) + ("Receive After" "after" erlang-skel-receive-after) + ("Receive Loop" "loop" erlang-skel-receive-loop) + ("Module" "module" erlang-skel-module) + ("Author" "author" erlang-skel-author) + () + ("Small Header" "small-header" + erlang-skel-small-header erlang-skel-header) + ("Normal Header" "normal-header" + erlang-skel-normal-header erlang-skel-header) + ("Large Header" "large-header" + erlang-skel-large-header erlang-skel-header) + () + ("Small Server" "small-server" + erlang-skel-small-server erlang-skel-header) + () + ("Application" "application" + erlang-skel-application erlang-skel-header) + ("General Tcp Receive" "fs_gen_tcp_recv" + erlang-skel-fs-gen-tcp-recv erlang-skel-header) + ("Test Suite" "test-suite" + erlang-skel-test-suite erlang-skel-header) + ("Tcp Gateway" "fs_tcp_gateway" + erlang-skel-fs-tcp-gateway erlang-skel-header) + ("Edoc function" "fs_edoc_header" + erlang-skel-fs-edoc-header erlang-skel-header) + ("DB Initialize" "fs_db_init" + erlang-skel-fs-db-init erlang-skel-header) + ("gen_leader" "generic-leader" + erlang-skel-generic-leader erlang-skel-header) + ("Supervisor" "supervisor" + erlang-skel-supervisor erlang-skel-header) + ("supervisor_bridge" "supervisor-bridge" + erlang-skel-supervisor-bridge erlang-skel-header) + ("gen_server" "generic-server" + erlang-skel-generic-server erlang-skel-header) + ("gen_event" "gen-event" + erlang-skel-gen-event erlang-skel-header) + ("gen_fsm" "gen-fsm" + erlang-skel-gen-fsm erlang-skel-header) + ("Library module" "gen-lib" + erlang-skel-lib erlang-skel-header) + ("Corba callback" "gen-corba-cb" + erlang-skel-corba-callback erlang-skel-header)) + "*Description of all skeletons templates. +Both functions and menu entries will be created. + +Each entry in `erlang-skel' should be a list with three or four +elements, or the empty list. + +The first element is the name which shows up in the menu. The second +is the `tempo' identfier (The string \"erlang-\" will be added in +front of it). The third is the skeleton descriptor, a variable +containing `tempo' attributes as described in the function +`tempo-define-template'. The optional fourth elements denotes a +function which should be called when the menu is selected. + +Functions corresponding to every template will be created. The name +of the function will be `tempo-template-erlang-X' where `X' is the +tempo identifier as specified in the second argument of the elements +in this list. + +A list with zero elements means that the a horisontal line should +be placed in the menu.") + +;; In XEmacs `user-mail-address' returns "x@y.z (Foo Bar)" ARGH! +;; What's wrong with that? RFC 822 says it's legal. [sverkerw] +(defvar erlang-skel-mail-address + (concat (user-login-name) "@" + (or (and (boundp 'mail-host-address) + (symbol-value 'mail-host-address)) + (system-name))) + "Mail address of the user.") + +;; Expression templates: +(defvar erlang-skel-case + '((erlang-skel-skip-blank) o > + "case " p " of" n> p "_ ->" n> p "ok" n> "end" p) + "*The skeleton of a `case' expression. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-if + '((erlang-skel-skip-blank) o > + "if" n> p " ->" n> p "ok" n> "end" p) + "The skeleton of an `if' expression. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-receive + '((erlang-skel-skip-blank) o > + "receive" n> p "_ ->" n> p "ok" n> "end" p) + "*The skeleton of a `receive' expression. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-receive-after + '((erlang-skel-skip-blank) o > + "receive" n> p "_ ->" n> p "ok" n> "after " p "T ->" n> + p "ok" n> "end" p) + "*The skeleton of a `receive' expression with an `after' clause. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-receive-loop + '(& o "loop(" p ") ->" n> "receive" n> p "_ ->" n> + "loop(" p ")" n> "end.") + "*The skeleton of a simple `recieve' loop. +Please see the function `tempo-define-template'.") + + +;; Attribute templates + +(defvar erlang-skel-module + '(& "-module(" + (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) + ")." n) + "*The skeleton of a `module' attribute. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-author + '(& "-author('" erlang-skel-mail-address "')." n) + "*The skeleton of a `author' attribute. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-vc nil + "*The skeleton template to generate a version control attribute. +The default is to insert nothing. Example of usage: + + (setq erlang-skel-vc '(& \"-rcs(\\\"$\Id: $ \\\").\") n) + +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-export + '(& "-export([" n> "])." n) + "*The skeleton of an `export' attribute. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-import + '(& "%%-import(Module, [Function/Arity, ...])." n) + "*The skeleton of an `import' attribute. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-compile nil +;; '(& "%%-compile(export_all)." n) + "*The skeleton of a `compile' attribute. +Please see the function `tempo-define-template'.") + + +;; Comment templates. + +(defvar erlang-skel-date-function 'erlang-skel-dd-mmm-yyyy + "*Function which returns date string. +Look in the module `time-stamp' for a battery of functions.") + +(defvar erlang-skel-copyright-comment '() + "*The template for a copyright line in the header, normally empty. +This variable should be bound to a `tempo' template, for example: + '(& \"%%% Copyright (C) 2000, Yoyodyne, Inc.\" n) + +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-created-comment + '(& "%%% Created : " (funcall erlang-skel-date-function) " by " + (user-full-name) " <" erlang-skel-mail-address ">" n) + "*The template for the \"Created:\" comment line.") + +(defvar erlang-skel-author-comment + '(& "%%% Author : " (user-full-name) " <" erlang-skel-mail-address ">" n) + "*The template for creating the \"Author:\" line in the header. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-file-comment + '(& "%%% File : " (file-name-nondirectory buffer-file-name) n) + "*The template for creating the \"Module:\" line in the header. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-small-header + '(o (erlang-skel-include erlang-skel-module) +;; erlang-skel-author) + n + (erlang-skel-include erlang-skel-compile +;; erlang-skel-export + erlang-skel-vc)) + "*The template of a small header without any comments. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-normal-header + '(o (erlang-skel-include erlang-skel-copyright-comment + erlang-skel-file-comment + erlang-skel-author-comment) + "%%% Description : " p n + (erlang-skel-include erlang-skel-created-comment) n + (erlang-skel-include erlang-skel-small-header) n) + "*The template of a normal header. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-large-header + '(o "%%% $Id: erlang.el,v 1.21 2004/08/03 20:38:43 mlogan Exp $" n (erlang-skel-separator) + (erlang-skel-include erlang-skel-copyright-comment + erlang-skel-file-comment + erlang-skel-author-comment) + "%%%" n + "%%% @doc " p n + "%%% @end" n + "%%%" n + (erlang-skel-include erlang-skel-created-comment) + (erlang-skel-separator) + (erlang-skel-include erlang-skel-small-header) ) + "*The template of a large header. +Please see the function `tempo-define-template'.") + + +;; Server templates. + +(defvar erlang-skel-small-server + '((erlang-skel-include erlang-skel-large-header) + (erlang-skel-separator 2) + "%% Include files" n + (erlang-skel-separator 2) n + (erlang-skel-separator 2) + "%% External exports" n + (erlang-skel-separator 2) + "-export([start_link/0])." n n + (erlang-skel-separator 2) + "%% Internal exports" n + (erlang-skel-separator 2) + "-export([init/1])." n n + n + (erlang-skel-separator 2) + "%% Macros" n + (erlang-skel-separator 2) + "-define(SERVER, ?MODULE)." n + n + (erlang-skel-separator 2) + "%% Records" n + (erlang-skel-separator 2) + n + (erlang-skel-double-separator 2) + "%% External functions" n + (erlang-skel-double-separator 2) + n + (erlang-skel-separator 2) + "%% @doc The starting point." n + "%% @spec start_link() -> {ok, Pid}" n + "%% @end" n + (erlang-skel-separator 2) + "start_link() ->" n> + "proc_lib:start_link(?MODULE, init, [self()])." n n + (erlang-skel-double-separator 2) + "%% Server functions" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Description: Initializes this server." n + "%% Variables:" n + "%% From - The pid of the parent process." n + (erlang-skel-separator 2) + "init(From) ->" n> + "register(?SERVER, self())," n> + "proc_lib:init_ack(From, {ok, self()})," n> + "loop(From)." n n + (erlang-skel-double-separator 2) + "%% Internal functions" n + (erlang-skel-double-separator 2) + "loop(From) ->" n> + "receive" n> + p "_ ->" n> + "loop(From)" n> + "end." + ) + "*Template of a small server. +Please see the function `tempo-define-template'.") + +;; Behaviour templates. + +(defvar erlang-skel-application + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(application)." n + (erlang-skel-separator 2) + "%% Include files" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% External exports" n + (erlang-skel-separator 2) + "-export([" n> + "start/2," n> + "shutdown/0," n> + "stop/1" n> + "])." n + n + (erlang-skel-separator 2) + "%% Macros" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% Records" n + (erlang-skel-separator 2) + n + (erlang-skel-double-separator 2) + "%% External functions" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% @doc The starting point for an erlang application." n + "%% @spec start(Type, StartArgs) -> {ok, Pid} | {ok, Pid, State} | {error, Reason}" n + "%% @end" n + (erlang-skel-separator 2) + "start(Type, StartArgs) ->" n> + "case "(erlang-get-module-from-file-name)"_sup:start_link(StartArgs) of" n> + "{ok, Pid} -> " n> + "{ok, Pid};" n> + "Error ->" n> + "Error" n> + "end." n + n + (erlang-skel-separator 2) + "%% @doc Called to shudown the "(erlang-get-module-from-file-name)" application." n + "%% @spec shutdown() -> ok "n + "%% @end"n + (erlang-skel-separator 2) + "shutdown() ->" n> + "application:stop("(erlang-get-module-from-file-name)")." n + n + (erlang-skel-double-separator 2) + "%% Internal functions" n + (erlang-skel-double-separator 2) + n + (erlang-skel-separator 2) + "%% Called upon the termintion of an application." n + (erlang-skel-separator 2) + "stop(State) ->" n> + "ok." n + n + ) + "*The template of an application behaviour. +Please see the function `tempo-define-template'.") + +;; Martins work + +;; test server test suite template +(defvar erlang-skel-test-suite + '((erlang-skel-include erlang-skel-copyright-comment + erlang-skel-file-comment + erlang-skel-author-comment) + "%%%" n + "%%% @doc " p n + "%%%

A test spec consists of the test server required functions as detailed" n + "%%% by the comments for the functions themselves further down in this" n + "%%% file. The rest of a test suite consists of user defined Case functions" n + "%%% as referenced by the suite clause of the all/1 function and "n + "%%% described below.

"n + "%%%"n + "%%% " + "%%% Case(doc) -> [Decription]" n + "%%% Case(suite) -> [] | TestSpec | {skip, Comment}" n + "%%% Case(Config) -> {skip, Comment} | {comment, Comment} | Ok" n + "%%% 
"n
+    "%%%"n
+    "%%% Variables:" n
+    "%%%  Description - Short description of the test case TestSpec" n
+    "%%%  Comment - This comment will be printed on the HTML result page " n
+    "%%%"n
+    "%%% Types:" n
+    "%%%  Description = string()" n
+    "%%%  TestSpec = list()" n
+    "%%%  Ok = term()" n
+    "%%%  Comment = string()" n
+    "%%%  Config = term()" n
+    "%%%
" n + "%%%

The documentation clause (argument doc) can be used for" n + "%%% automatic generation of test documentation or test descriptions.

" n + "%%%"n + "%%%

The specification clause (argument spec) shall return an empty" n + "%%% list, the test specification for the test case or {skip,Comment}." n + "%%% The syntax of a test specification is described in the reference " n + "%%% manual for the Test Server application.

" n + "%%%"n + "%%%

Note that the specification clause always is executed on "n + "%%% the controller host.

"n + "%%%"n + "%%%

The execution clause (argument Config) is only called if "n + "%%% the specification clause returns an empty list. The execution "n + "%%% clause is the real test case. Here you must call the functions "n + "%%% you want to test, and do whatever you need to check the result. "n + "%%% If someting fails, make sure the process crashes or call "n + "%%% test_server:fail/0/1 (which also will cause the process to crash).

"n + "%%%"n + "%%%

You can return {skip,Comment} if you decide not to run the "n + "%%% test case after all, e.g. if it is not applicable on this platform.

"n + "%%%"n + "%%%

You can return {comment,Comment} if you wish to print some "n + "%%% information in the 'Comment' field on the HTML result page.

"n + "%%%"n + "%%%

If the execution clause returns anything else, it is considered "n + "%%% a success.

"n + "%%% @end" n + "%%%" n + (erlang-skel-include erlang-skel-created-comment) + (erlang-skel-separator) + (erlang-skel-include erlang-skel-small-header) + (erlang-skel-separator 2) + "%% Include files" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% Macro Definitions" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% Test Suite Exports" n + (erlang-skel-separator 2) + "-export(["n>"all/1,"n>"init_per_testcase/2,"n>"fin_per_testcase/2"n>"])." n + n + (erlang-skel-separator 2) + "%% External Exports - test cases must be exported." n + (erlang-skel-separator 2) + "-export(["n>"])."n + n + (erlang-skel-double-separator 2) + "%% Test Server Functions" n + (erlang-skel-double-separator 2) + n + (erlang-skel-separator 2) + "%% @doc This function returns the test specification for the test suite module."n + "%% 
"n
+    "%% Types:"n
+    "%%  TestSpec = list()"n
+    "%%  Comment = string()"n
+    "%%"n
+    "%%
"n + "%% @spec all(suite) -> TestSpec | {skip, Comment}"n + "%% @end"n + (erlang-skel-separator 2) + "all(doc) -> [];"n + "all(suite) -> []."n n + n + (erlang-skel-separator 2) + "%% @doc This function is called before each test case."n + "%% 
"n
+    "%% Types:"n
+    "%%  Case = atom()"n
+    "%%  Config = NewConfig = term()"n
+    "%%"n
+    "%%
"n + "%% @spec init_per_testcase(Case, Config) -> NewConfig"n + "%% @end"n + (erlang-skel-separator 2) + "init_per_testcase(Case, Config) -> []."n n + n + (erlang-skel-separator 2) + "%% @doc This function is called after each test case."n + "%% 
"n
+    "%% Types:"n
+    "%%  Case = atom()"n
+    "%%  Config = term()"n
+    "%%"n
+    "%%
"n + "%% @spec fin_per_testcase(Case, Config) -> void()"n + "%% @end"n + (erlang-skel-separator 2) + "fin_per_testcase(Case, Config) -> ok."n n + n + (erlang-skel-double-separator 2) + "%% Individual Test Case Functions" n + (erlang-skel-double-separator 2) + n + (erlang-skel-separator 2) + "%% @doc ." n + "%% @end" n + (erlang-skel-separator 2) + "Case(doc) -> [];"n + "Case(suite) -> [];"n + "Case(Config) when list(Config) -> ok."n n + n + (erlang-skel-double-separator 2) + "%% Internal Functions" n + (erlang-skel-double-separator 2) + ) + "*The template of an application behaviour. +Please see the function `tempo-define-template'.") + + +;; fs_tcp_gateway template +(defvar erlang-skel-fs-tcp-gateway + '((erlang-skel-include erlang-skel-large-header) + "%% TODO Implement this behaviour" n + "%% -behaviour(tcp_gateway)." n + (erlang-skel-separator 2) + "%% Include files" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% External exports" n + (erlang-skel-separator 2) + "-export([" n> "start_link/1, init/0, sync_request/5, async_request/5, terminate/2" n + " ])." n + n + (erlang-skel-separator 2) + "%% Macros" n + (erlang-skel-separator 2) + "-define(SERVER, ?MODULE)." n + n + (erlang-skel-separator 2) + "%% Records" n + (erlang-skel-separator 2) + "-record(state, {})."n + n + (erlang-skel-double-separator 2) + "%% External functions" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% @doc Starts the gateway server."n + "%% 
"n
+    "%%"n
+    "%% Expects:"n
+    "%%  Port - The port number to bind to."n
+    "%%"n
+    "%% Types:"n
+    "%%  Port = integer()"n
+    "%%"n
+    "%%
"n + "%%"n + "%% @spec start_link(Port) -> {ok, pid()}"n + "%% @end"n + (erlang-skel-separator 2) + "start_link(Port) ->" n> + "CallBackModule = ?MODULE,"n> + " fs_tcp_gateway:start_link(CallBackModule, Port)."n + n + (erlang-skel-double-separator 2) + "%% Callbacks" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% @doc Initialization stage for each new connection to the gateway server."n + "%% 
"n
+    "%%"n
+    "%% Types:"n
+    "%%  State = term()"n
+    "%%"n
+    "%%
"n + "%%"n + "%% @spec init() -> {ok, State}"n + "%% @end"n + (erlang-skel-separator 2) + "init() ->"n> + "{ok, #state{}}."n + n + (erlang-skel-separator 2) + "%% @doc Called when the server receives a syncronous request from a client."n + "%% 
"n
+    "%%"n
+    "%% Expects:"n
+    "%%  ID - The request ID number"n
+    "%%  M - module name"n
+    "%%  F - function name"n
+    "%%  A - List of arguments"n
+    "%%  Reply - A message sent back over the tcp stream to the client"n
+    "%%"n
+    "%% Types:"n
+    "%%  ID = M = F = Reply = string()"n
+    "%%  A = [string()]"n
+    "%%  State = term()"n
+    "%%  Reply = string()"n
+    "%%"n
+    "%%
"n + "%%"n + "%% @spec sync_request(ID, M, F, A, State) ->"n + "%% {reply, Reply, State} | {stop, Reply, Reason, State} | {noreply, State}"n + "%% @end"n + (erlang-skel-separator 2) + "sync_request(ID, M, F, A, State) ->"n> + "{reply, \"sync ok\", State}."n + n + (erlang-skel-separator 2) + "%% @doc Called when the server receives a asyncronous request from a client."n + "%% 
"n
+    "%%"n
+    "%% Expects:"n
+    "%%  ID - The request ID number"n
+    "%%  M - module name"n
+    "%%  F - function name"n
+    "%%  A - List of arguments"n
+    "%%  Reply - A message sent back over the tcp stream to the client"n
+    "%%"n
+    "%% Types:"n
+    "%%  ID = M = F = string()"n
+    "%%  A = [string()]"n
+    "%%  State = term()"n
+    "%%  Reply = string()"n
+    "%%"n
+    "%%
"n + "%%"n + "%% @spec async_request(ID, M, F, A, State) ->"n + "%% {stop, Reason, State} | {noreply, State}"n + "%% @end"n + (erlang-skel-separator 2) + "async_request(ID, M, F, A, State) ->"n> + "{noreply, State}."n + n + (erlang-skel-separator 2) + "%% @doc Called upon the shutdown of a connection."n + "%% @spec terminate(Reason, State) -> void()"n + "%% @end"n + (erlang-skel-separator 2) + "terminate(Reason, State) ->"n> + "ok."n + n + (erlang-skel-double-separator 2) + "%% Internal functions" n + (erlang-skel-double-separator 2) + ) + "*The template of a fs_tcp_gateway behaviour. +Please see the function `tempo-define-template'.") + + +;; gen_tcp_recv template +(defvar erlang-skel-fs-gen-tcp-recv + '((erlang-skel-include erlang-skel-large-header) + "%% TODO Implement this behaviour" n + "%% -behaviour(gen_tcp_recv)." n + (erlang-skel-separator 2) + "%% External exports" n + (erlang-skel-separator 2) + "-export([" n> "start_link/0" n> "])." n n + (erlang-skel-separator 2) + "%% Server Callbacks" n + (erlang-skel-separator 2) + "-export([" n> "init/1," n> "handle_packet/3," n> "handle_call/4" n> + "handle_info/3" n> "terminate/2" n> "])." n n + (erlang-skel-separator 2) + "%% Include files" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% API - External Exports" n + (erlang-skel-separator 2) + "-export([" n> + "start_link/1" n> + "])." n + n + (erlang-skel-separator 2) + "%% Macros" n + (erlang-skel-separator 2) + "-define(SERVER, ?MODULE)." n + n + (erlang-skel-separator 2) + "%% Records" n + (erlang-skel-separator 2) + n + (erlang-skel-double-separator 2) + "%% External functions" n + (erlang-skel-double-separator 2) n + (erlang-skel-separator 2) + "%% @doc Starts the fs_gen_tcp_recv server." n + "%% @spec start_link() -> {ok, Pid}" n + "%% @end" n + (erlang-skel-separator 2) + "start_link() ->" n> + "fs_gen_tcp_recv:start_link(CallbackModule, ?TCP_PORT, [], [], [])." n n n + (erlang-skel-double-separator 2) + "%% Server Functions" n + (erlang-skel-double-separator 2) n + (erlang-skel-separator 2) + "%% Initializes the state for a gen_tcp_recv server." n + "%% Returns: {ok, State}" n + "%% State = term()" n + (erlang-skel-separator 2) + "init([]) ->" n> + "{ok, []}." n n n + (erlang-skel-separator 2) + "%% Receives packets from the socket. Also receives timout messages." n + "%% Types:" n + "%% Socket = socket()" n + "%% Packet = binary() | string(). Can be altered in TCPOptions" n + "%% Reply = binary() | string(). Can be altered in TCPOptions" n + "%% State = NewState = term()" n + "%% Timeout = integer() in miliseconds." n + "%% Returns: " n + "%% {noreply, NewState} {noreply, NewState, Timeout}" n + "%% {reply, Reply, NewState} {reply, Reply, NewState, Timeout}" n + "%% {stop, Reason, NewState}" n + (erlang-skel-separator 2) + "handle_packet(Socket, Packet, State) ->" n> + "{noreply, State}." n n n + (erlang-skel-separator 2) + "%% Receives sync calls from a client." n + "%% Variables:" n + "%% Reply - A message sent back to the caller." n + "%% " n + "%% Types:" n + "%% Socket = socket()" n + "%% Msg = Reply = term()" n + "%% State = NewState = term()" n + "%% Timeout = integer() in miliseconds." n + "%% Returns: " n + "%% {noreply, NewState} {noreply, NewState, Timeout}" n + "%% {reply, Reply, NewState} {reply, Reply, NewState, Timeout}" n + "%% {stop, Reason, NewState} | {stop, Reason, Reply, NewState}" n + (erlang-skel-separator 2) + "handle_call(Socket, From, Msg, State) ->" n> + "{reply, Reply, State}." n n n + (erlang-skel-separator 2) + "%% Receives messages from other processes and timeouts." n + "%% Types:" n + "%% Socket = socket()" n + "%% Msg = term() | timeout" n + "%% State = NewState = term()" n + "%% Timeout = integer() in miliseconds." n + "%% Returns: " n + "%% {noreply, NewState} {noreply, NewState, Timeout}" n + "%% {stop, Reason, NewState}" n + (erlang-skel-separator 2) + "handle_info(Socket, Msg, State) ->" n> + "{noreply, State}." n n n + (erlang-skel-separator 2) + "%% Called after a socket closes or {stop, Reason, NewState}" n + "%% Types:" n + "%% Socket = socket()" n + "%% State = NewState = term()" n + "%% Returns: term()" n + (erlang-skel-separator 2) + "terminate(Socket, State) ->" n> + "ok." n n n + (erlang-skel-double-separator 2) + "%%% Internal Functions" n + (erlang-skel-double-separator 2) + ) + "*The template of a fs_gen_tcp_recv behaviour. +Please see the function `tempo-define-template'.") + +;; fs_edoc_header template +(defvar erlang-skel-fs-edoc-header + '((erlang-skel-separator 2) + "%% @doc" n + "%% 
" n
+    "%% Variables:" n
+    "%% Types:" n
+    "%%
term()" n + "%% @spec" n + "%% @end" n + (erlang-skel-separator 2) + ) + "*The template of an edoc function header. +Please see the function `tempo-define-template'.") + +;; fs_db_init template +(defvar erlang-skel-fs-db-init + '((erlang-skel-include erlang-skel-large-header) + "%% TODO Implement this behaviour" n + "%% -behaviour(db_init)." n + (erlang-skel-separator 2) + "%% Include files" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% External exports" n + (erlang-skel-separator 2) + "-export([" n> "start_link/1, start_link/3, init/1, local_init/0, remote_init/0" n + " ])." n + n + (erlang-skel-separator 2) + "%% Macros" n + (erlang-skel-separator 2) + "-define(SERVER, ?MODULE)." n + n + (erlang-skel-separator 2) + "%% Records" n + (erlang-skel-separator 2) + n + (erlang-skel-double-separator 2) + "%% External functions" n + (erlang-skel-separator 2) + "%% @doc Starts the server. " n> + "%% 
" n>
+    "%% Variables:" n>
+    "%%  CallBackModule - The module that exhibits the db init behaviour." n>
+    "%%  Args - A list of arguments delivered to the CallBackModule:init/1 function." n>
+    "%%  Options - A list of options for fs_db_init." n>
+    "%%" n>
+    "%% The options are as follows:" n>
+    "%%  {schema_type, Type}" n>
+    "%%" n>
+    "%% Types:" n>
+    "%%  Args = list()" n>
+    "%%  Options = list()" n>
+    "%%  Type = ram_copies | disc_copies | disc_only_copies" n>
+    "%%" n>
+    "%%
" n> + "%% @spec start_link(CallBackModule, Args, Options) -> {ok, pid()} | {error, Reason}" n> + "%% @end" n> + "(erlang-skel-separator 2)" + "start_link(CallBackModule, Args, Options) ->" n> + "proc_lib:start_link(?MODULE, db_init, [self(), CallBackModule, Args, Options])." n> + n + "%% @spec start_link(CallBackModule) -> {ok, pid()} | {error, Reason}" n> + "%% @equiv start_link(CallBackModule, [], [])" n> + "start_link(CallBackModule) ->" n> + "start_link(CallBackModule, [], [])." n> + n + (erlang-skel-double-separator 2) + "%% Callbacks" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% @doc" n + "%% Returns a list of nodes that db_init should try to replicate with." n + "%%" n + "%% 
"  n
+    "%% Types:" n
+    "%%  DBNodes = [node()]" n
+    "%%
" n + "%%" n + "%% @spec init(Args) -> {ok, DBNodes} | no_init" n + "%% @end" n + (erlang-skel-separator 2) + "init(Args) ->" n + " {ok, DBNodesToReplicateFrom = []}." n + (erlang-skel-separator 2) + "%% @doc" n + "%% Created a schema and seeds the local database." n + "%% Returns a list of records with their initial data." n + "%% These are to be the tables and initial values for the database." n + "%%" n + "%% 
" n
+    "%% Reclist = [record()]" n
+    "%% Reason = atom()" n
+    "%%
" n + "%%" n + "%% @spec local_init() -> {ok, RecList} | {error, Reason}" n + "%% @end" n + (erlang-skel-separator 2) + "local_init() ->" n + " {ok, []}." n + (erlang-skel-separator 2) + "%% @doc Pushes the schema and the table definitions to the node" n + "%% specified by the variable node." n + "%% NOTE: Do not include the schema in this list." n + "%%" n + "%% 
" n
+    "%% Types " n
+    "%%  Node = node()" n
+    "%%  TableList = [{Table, Type}]" n
+    "%%   Table = atom()" n
+    "%%   Type = ram_copies, disc_copies" n
+    "%%  Reason = atom()" n
+    "%%
" n + "%%" n + "%% @spec remote_init() -> {ok, TableList} | {error, Reason}" n + "%% @end" n + (erlang-skel-separator 2) + "remote_init() ->" n + " {ok, [{ini, ram_copies}]}." n + n + ) + "*The template of a fs_db_init behaviour. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-supervisor + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(supervisor)." n + (erlang-skel-separator 2) + "%% Include files" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% External exports" n + (erlang-skel-separator 2) + "-export([" n> "start_link/1" n + " ])." n + n + (erlang-skel-separator 2) + "%% Internal exports" n + (erlang-skel-separator 2) + "-export([" n> "init/1" n + " ])." n + n + (erlang-skel-separator 2) + "%% Macros" n + (erlang-skel-separator 2) + "-define(SERVER, ?MODULE)." n + n + (erlang-skel-separator 2) + "%% Records" n + (erlang-skel-separator 2) + n + (erlang-skel-double-separator 2) + "%% External functions" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% @doc Starts the supervisor." n + "%% @spec start_link(StartArgs) -> {ok, pid()} | Error" n + "%% @end" n + (erlang-skel-separator 2) + "start_link(StartArgs) ->" n> + "supervisor:start_link({local, ?SERVER}, ?MODULE, [])." n + n + (erlang-skel-double-separator 2) + "%% Server functions" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Func: init/1" n + "%% Returns: {ok, {SupFlags, [ChildSpec]}} |" n + "%% ignore |" n + "%% {error, Reason} " n + (erlang-skel-separator 2) + "init([]) ->" n> + "RestartStrategy = one_for_one," n> + "MaxRestarts = 1000," n> + "MaxTimeBetRestarts = 3600," n> + n> + "SupFlags = {RestartStrategy, MaxRestarts, MaxTimeBetRestarts}," n> + n> + "ChildSpecs =" n> + "[" n> + "{AppName," n> + "{AppName, start_link, []}," n> + "permanent," n> + "1000," n> + "worker," n> + "[AppName]}" n> + "]," n> + "{ok,{SupFlags, ChildSpecs}}." n + + (erlang-skel-double-separator 2) + "%% Internal functions" n + (erlang-skel-double-separator 2) + ) + "*The template of an supervisor behaviour. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-supervisor-bridge + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(supervisor_bridge)." n + (erlang-skel-separator 2) + "%% Include files" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% External exports" n + (erlang-skel-separator 2) + "-export([" n> "start_link/0" n + " ])." n + n + (erlang-skel-separator 2) + "%% Internal exports" n + (erlang-skel-separator 2) + "-export([" n> "init/1, " n> "terminate/2" n + " ])." n + n + (erlang-skel-separator 2) + "%% Macros" n + (erlang-skel-separator 2) + "-define(SERVER, ?MODULE)." n + n + (erlang-skel-separator 2) + "%% Records" n + (erlang-skel-separator 2) + "-record(state, {})." n + n + (erlang-skel-double-separator 2) + "%% External functions" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: start_link/0" n + "%% Description: Starts the supervisor bridge" n + (erlang-skel-separator 2) + "start_link() ->" n> + "supervisor_bridge:start_link({local, ?SERVER}, ?MODULE, [])." n + n + (erlang-skel-double-separator 2) + "%% Server functions" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Func: init/1" n + "%% Returns: {ok, Pid, State} |" n + "%% ignore |" n + "%% {error, Reason} " n + (erlang-skel-separator 2) + "init([]) ->" n> + "case 'AModule':start_link() of" n> + "{ok, Pid} ->" n> + "{ok, Pid, #state{}};" n> + "Error ->" n> + "Error" n> + "end." n + n + (erlang-skel-separator 2) + "%% Func: terminate/2" n + "%% Purpose: Synchronized shutdown of the underlying sub system." n + "%% Returns: any" n + (erlang-skel-separator 2) + "terminate(Reason, State) ->" n> + "'AModule':stop()," n> + "ok." n + n + (erlang-skel-double-separator 2) + "%% Internal functions" n + (erlang-skel-double-separator 2) + ) + "*The template of an supervisor_bridge behaviour. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-generic-server + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(gen_server)." n + (erlang-skel-separator 2) + "%% Include files" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% External exports" n + (erlang-skel-separator 2) + "-export([" n>"start_link/0,"n>"stop/0"n>"])." n + n + (erlang-skel-separator 2) + "%% gen_server callbacks" n + (erlang-skel-separator 2) + "-export([init/1, handle_call/3, handle_cast/2, " + "handle_info/2, terminate/2, code_change/3])." n n + (erlang-skel-separator 2) + "%% record definitions" n + (erlang-skel-separator 2) + "-record(state, {})." n n + (erlang-skel-separator 2) + "%% macro definitions" n + (erlang-skel-separator 2) + "-define(SERVER, ?MODULE)." n + n + (erlang-skel-double-separator 2) + "%% External functions" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% @doc Starts the server." n + "%% @spec start_link() -> {ok, pid()} | {error, Reason}" n + "%% @end"n + (erlang-skel-separator 2) + "start_link() ->" n> + "gen_server:start_link({local, ?SERVER}, ?MODULE, [], [])." n + n + (erlang-skel-separator 2) + "%% @doc Stops the server." n + "%% @spec stop() -> ok" n + "%% @end"n + (erlang-skel-separator 2) + "stop() ->" n> + "gen_server:cast(?SERVER, stop)." n + n + (erlang-skel-double-separator 2) + "%% Server functions" n + (erlang-skel-double-separator 2) + n + (erlang-skel-separator 2) + "%% Function: init/1" n + "%% Description: Initiates the server" n + "%% Returns: {ok, State} |" n + "%% {ok, State, Timeout} |" n + "%% ignore |" n + "%% {stop, Reason}" n + (erlang-skel-separator 2) + "init([]) ->" n> + "{ok, #state{}}." n + n + (erlang-skel-separator 2) + "%% Function: handle_call/3" n + "%% Description: Handling call messages" n + "%% Returns: {reply, Reply, State} |" n + "%% {reply, Reply, State, Timeout} |" n + "%% {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, Reply, State} | (terminate/2 is called)" n + "%% {stop, Reason, State} (terminate/2 is called)" n + (erlang-skel-separator 2) + "handle_call(Request, From, State) ->" n> + "Reply = ok," n> + "{reply, Reply, State}." n + n + (erlang-skel-separator 2) + "%% Function: handle_cast/2" n + "%% Description: Handling cast messages" n + "%% Returns: {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, State} (terminate/2 is called)" n + (erlang-skel-separator 2) + "handle_cast(stop, State) ->" n> + "{stop, normal, State};" n + "handle_cast(Msg, State) ->" n> + "{noreply, State}." n + n + (erlang-skel-separator 2) + "%% Function: handle_info/2" n + "%% Description: Handling all non call/cast messages" n + "%% Returns: {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, State} (terminate/2 is called)" n + (erlang-skel-separator 2) + "handle_info(Info, State) ->" n> + "{noreply, State}." n + n + (erlang-skel-separator 2) + "%% Function: terminate/2" n + "%% Description: Shutdown the server" n + "%% Returns: any (ignored by gen_server)" n + (erlang-skel-separator 2) + "terminate(Reason, State) ->" n> + "ok." n + n + (erlang-skel-separator 2) + "%% Func: code_change/3" n + "%% Purpose: Convert process state when code is changed" n + "%% Returns: {ok, NewState}" n + (erlang-skel-separator 2) + "code_change(OldVsn, State, Extra) ->" n> + "{ok, State}." n + n + (erlang-skel-double-separator 2) + "%%% Internal functions" n + (erlang-skel-double-separator 2) + ) + "*The template of a generic server. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-gen-event + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(gen_event)." n + (erlang-skel-separator 2) + "%% Include files" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% External exports" n + (erlang-skel-separator 2) + "-export([start_link/0, add_handler/0])." n + n + (erlang-skel-separator 2) + "%% gen_event callbacks" n + (erlang-skel-separator 2) + "-export([init/1, handle_event/2, handle_call/2, " + "handle_info/2, terminate/2, code_change/3])." n n + (erlang-skel-separator 2) + "%% Record Definitions" n + (erlang-skel-separator 2) + "-record(state, {})." n n + (erlang-skel-separator 2) + "%% Macro Definitions" n + (erlang-skel-separator 2) + "-define(SERVER, ?MODULE)." n + n + (erlang-skel-double-separator 2) + "%% External functions" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% @doc Starts the server" n + "%% @spec start_link() -> {ok, Pid} | {error, {already_started, Pid}}" n + "%% @end" n + (erlang-skel-separator 2) + "start_link() ->" n> + "gen_event:start_link({local, ?SERVER}). " n + n + (erlang-skel-separator 2) + "%% @doc Adds an event handler" n + "%% @spec add_handler() -> ok | {'EXIT', Reason}" n + "%% @end" n + (erlang-skel-separator 2) + "add_handler() ->" n> + "gen_event:add_handler(?SERVER, ?MODULE, [])." n + n + (erlang-skel-double-separator 2) + "%% Server functions" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Func: init/1" n + "%% Returns: {ok, State} |" n + "%% Other" n + (erlang-skel-separator 2) + "init([]) ->" n> + "{ok, #state{}}." n + n + (erlang-skel-separator 2) + "%% Func: handle_event/2" n + "%% Returns: {ok, State} |" n + "%% {swap_handler, Args1, State1, Mod2, Args2} |" n + "%% remove_handler " n + (erlang-skel-separator 2) + "handle_event(Event, State) ->" n> + "{ok, State}." n + n + (erlang-skel-separator 2) + "%% Func: handle_call/2" n + "%% Returns: {ok, Reply, State} |" n + "%% {swap_handler, Reply, Args1, State1, Mod2, Args2} |" n + "%% {remove_handler, Reply} " n + (erlang-skel-separator 2) + "handle_call(Request, State) ->" n> + "Reply = ok," n> + "{ok, Reply, State}." n + n + (erlang-skel-separator 2) + "%% Func: handle_info/2" n + "%% Returns: {ok, State} |" n + "%% {swap_handler, Args1, State1, Mod2, Args2} |" n + "%% remove_handler " n + (erlang-skel-separator 2) + "handle_info(Info, State) ->" n> + "{ok, State}." n + n + (erlang-skel-separator 2) + "%% Func: terminate/2" n + "%% Purpose: Shutdown the server" n + "%% Returns: any" n + (erlang-skel-separator 2) + "terminate(Reason, State) ->" n> + "ok." n + n + (erlang-skel-separator 2) + "%% Func: code_change/3" n + "%% Purpose: Convert process state when code is changed" n + "%% Returns: {ok, NewState}" n + (erlang-skel-separator 2) + "code_change(OldVsn, State, Extra) ->" n> + "{ok, State}." n + n + (erlang-skel-separator 2) + "%%% Internal functions" n + (erlang-skel-separator 2) + ) + "*The template of a gen_event. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-gen-fsm + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(gen_fsm)." n + (erlang-skel-separator 2) + "%% Include files" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% External exports" n + "-export([start_link/0])." n + n + "%% gen_fsm callbacks" n + "-export([init/1, state_name/2, state_name/3, handle_event/3," n> + "handle_sync_event/4, handle_info/3, terminate/3, code_change/4])." n n + "-record(state, {})." n + n + (erlang-skel-double-separator 2) + "%% External functions" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: start_link/0" n + "%% Description: Starts the server" n + (erlang-skel-separator 2) + "start_link() ->" n> + "gen_fsm:start_link({local, ?SERVER}, ?MODULE, [], [])." n + n + (erlang-skel-double-separator 2) + "%% Server functions" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Func: init/1" n + "%% Returns: {ok, StateName, StateData} |" n + "%% {ok, StateName, StateData, Timeout} |" n + "%% ignore |" n + "%% {stop, StopReason} " n + (erlang-skel-separator 2) + "init([]) ->" n> + "{ok, state_name, #state{}}." n + n + (erlang-skel-separator 2) + "%% Func: StateName/2" n + "%% Returns: {next_state, NextStateName, NextStateData} |" n + "%% {next_state, NextStateName, NextStateData, Timeout} |" n + "%% {stop, Reason, NewStateData} " n + (erlang-skel-separator 2) + "state_name(Event, StateData) ->" n> + "{next_state, state_name, StateData}." n + n + (erlang-skel-separator 2) + "%% Func: StateName/3" n + "%% Returns: {next_state, NextStateName, NextStateData} |" n + "%% {next_state, NextStateName, NextStateData, Timeout} |" n + "%% {reply, Reply, NextStateName, NextStateData} |" n + "%% {reply, Reply, NextStateName, NextStateData, Timeout} |" n + "%% {stop, Reason, NewStateData} |" n + "%% {stop, Reason, Reply, NewStateData} " n + (erlang-skel-separator 2) + "state_name(Event, From, StateData) ->" n> + "Reply = ok," n> + "{reply, Reply, state_name, StateData}." n + n + (erlang-skel-separator 2) + "%% Func: handle_event/3" n + "%% Returns: {next_state, NextStateName, NextStateData} |" n + "%% {next_state, NextStateName, NextStateData, Timeout} |" n + "%% {stop, Reason, NewStateData} " n + (erlang-skel-separator 2) + "handle_event(Event, StateName, StateData) ->" n> + "{next_state, StateName, StateData}." n + n + (erlang-skel-separator 2) + "%% Func: handle_sync_event/4" n + "%% Returns: {next_state, NextStateName, NextStateData} |" n + "%% {next_state, NextStateName, NextStateData, Timeout} |" n + "%% {reply, Reply, NextStateName, NextStateData} |" n + "%% {reply, Reply, NextStateName, NextStateData, Timeout} |" n + "%% {stop, Reason, NewStateData} |" n + "%% {stop, Reason, Reply, NewStateData} " n + (erlang-skel-separator 2) + "handle_sync_event(Event, From, StateName, StateData) ->" n> + "Reply = ok," n> + "{reply, Reply, StateName, StateData}." n + n + (erlang-skel-separator 2) + "%% Func: handle_info/3" n + "%% Returns: {next_state, NextStateName, NextStateData} |" n + "%% {next_state, NextStateName, NextStateData, Timeout} |" n + "%% {stop, Reason, NewStateData} " n + (erlang-skel-separator 2) + "handle_info(Info, StateName, StateData) ->" n> + "{next_state, StateName, StateData}." n + n + (erlang-skel-separator 2) + "%% Func: terminate/3" n + "%% Purpose: Shutdown the fsm" n + "%% Returns: any" n + (erlang-skel-separator 2) + "terminate(Reason, StateName, StatData) ->" n> + "ok." n + n + (erlang-skel-separator 2) + "%% Func: code_change/4" n + "%% Purpose: Convert process state when code is changed" n + "%% Returns: {ok, NewState, NewStateData}" n + (erlang-skel-separator 2) + "code_change(OldVsn, StateName, StateData, Extra) ->" n> + "{ok, StateName, StateData}." n + n + (erlang-skel-separator 2) + "%%% Internal functions" n + (erlang-skel-separator 2) + ) + "*The template of a gen_fsm. +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-lib + '((erlang-skel-include erlang-skel-large-header) + (erlang-skel-separator 2) + "%% Include files" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% External exports" n + (erlang-skel-separator 2) + "-export([" n + " ])." n + n + (erlang-skel-separator 2) + "%% Internal exports" n + (erlang-skel-separator 2) + "-export([" n + " ])." n + n + (erlang-skel-separator 2) + "%% Macros" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% Records" n + (erlang-skel-separator 2) + n + (erlang-skel-double-separator 2) + "%% External functions" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% @doc" n + "%% @spec " n + "%% @end " n + (erlang-skel-separator 2) + n + (erlang-skel-double-separator 2) + "%% Internal functions" n + (erlang-skel-double-separator 2) + ) + "*The template of a library module. +Please see the function `tempo-define-template'.") + + +(defvar erlang-skel-generic-leader + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(fs_gen_leader)." n + (erlang-skel-separator 2) + "%% Include files" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% External exports" n + (erlang-skel-separator 2) + "-export([" n>"start_link/0,"n>"stop/0"n>"])." n + n + (erlang-skel-separator 2) + "%% gen_leader callbacks" n + (erlang-skel-separator 2) + "-export([init/1," n> + "elected/2," n> + "surrendered/3," n> + "handle_DOWN/3," n> + "handle_leader_call/4," n> + "handle_leader_cast/3," n> + "from_leader/3," n> + "handle_call/3," n> + "handle_cast/2," n> + "handle_info/2," n> + "terminate/2," n> + "code_change/4" n> + "])." n> + (erlang-skel-separator 2) + "%% record definitions" n + (erlang-skel-separator 2) + "-record(state, {})." n n + (erlang-skel-separator 2) + "%% macro definitions" n + (erlang-skel-separator 2) + "-define(SERVER, ?MODULE)." n + n + (erlang-skel-double-separator 2) + "%% External functions" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% @doc Starts the gen_leader." n + "%% @spec start_link() -> {ok, pid()} | {error, Reason}" n + "%% @end"n + (erlang-skel-separator 2) + "start_link() ->" n> + "Candidates = [node()|nodes()]," n> + "Workers = []," n> + "gen_leader:start_link({local, ?SERVER}, Candidates, Workers, ?MODULE, [], [])." n + n + (erlang-skel-separator 2) + "%% @doc Stops the gen_leader." n + "%% @spec stop() -> ok" n + "%% @end"n + (erlang-skel-separator 2) + "stop() ->" n> + "gen_leader:cast(?SERVER, stop)." n + n + (erlang-skel-double-separator 2) + "%% Server functions" n + (erlang-skel-double-separator 2) + n + + + + (erlang-skel-separator 2) + "%% Function: init/1" n> + "%% Description: Initiates the server" n> + "%% Returns: {ok, State} |" n> + "%% {ok, State, Timeout} |" n> + "%% ignore |" n> + "%% {stop, Reason}" n> + (erlang-skel-separator 2) + "init([]) ->" n> + "{ok, #state{}}." n + n + + (erlang-skel-separator 2) + "%% Called when we become the leader." n> + "%%" n> + "%% elected(State::state(), E::election()) -> {ok, Broadcast, NState}" n> + (erlang-skel-separator 2) + "elected(State, E) ->" n> + "BroadcastToAllCandidates = [],"n> + "{ok, BroadcastToAllCandidates , State}." n + n + + (erlang-skel-separator 2) + "%% Called by each candidate when it recognizes another instance as leader." n> + "%% Strictly speaking, this function is called when the candidate " n> + "%% acknowledges a leader and receives a Synch message in return." n> + "%%" n> + "%% surrendered(State::state(), Synch::broadcast(), E::election()) -> {ok, NState}" n> + (erlang-skel-separator 2) + "surrendered(State, BCastFromLeaderElectedCall, E) ->" n> + "{ok, State#state{leader_node = LeaderNode}}."n + n + + (erlang-skel-separator 2) + "%% Called by the leader when it detects loss of a candidate node." n> + "%% If the function returns a broadcast() object, this will" n> + "%% be sent to all candidates, and they will receive it in the function" n> + "%% link from_leader/3. from_leader/3" n> + "%%" n> + "%% handle_DOWN(Node::node(), State::state(), E::election()) -> {ok, NState} | {ok, Broadcast, NState}" n> + (erlang-skel-separator 2) + "handle_DOWN(Node, State, _E) ->" n> + "{ok, State}." n> + + (erlang-skel-separator 2) + "%% handle_leader_call(Msg::term(), From::callerRef(), State::state(), E::election()) -> " n> + "%% {reply, Reply, NState} |" n> + "%% {reply, Reply, Broadcast, NState} |" n> + "%% {noreply, state()} |" n> + "%% {stop, Reason, Reply, NState} |" n> + "%% commonReply()" n> + "%%" n> + "%% Called by the leader in response to a gen_leader:leader_call/2. leader_call()." n> + (erlang-skel-separator 2) + "handle_leader_call(Msg, _From, State, _E) ->" n> + "{reply, Reply = [], State}." n + n + + (erlang-skel-separator 2) + "%% Called by the leader in response to a gen_leader:leader_cast/2 leader_cast()" n> + "%% handle_leader_cast(Msg::term(), State::term(), E::election()) -> commonReply()" n> + "%%" n> + "%% BUG: This has not yet been implemented." n> + (erlang-skel-separator 2) + "handle_leader_cast(_Msg, State, _E) ->" n> + "{ok, State}." n + n + + (erlang-skel-separator 2) + "%% Called by each candidate in response to a message from the leader. " n> + "%% In this particular module, the leader passes an update function to be " n> + "%% applied to the candidate's state. " n> + "%% " n> + "%% from_leader(Msg::term(), State::state(), E::election()) -> {ok, NState} " n> + (erlang-skel-separator 2) + "from_leader(MSG, State, _E) -> " n> + "{ok, State}. " n + n + + n + (erlang-skel-separator 2) + "%% Function: handle_call/3" n + "%% Description: Handling call messages" n + "%% Returns: {reply, Reply, State} |" n + "%% {reply, Reply, State, Timeout} |" n + "%% {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, Reply, State} | (terminate/2 is called)" n + "%% {stop, Reason, State} (terminate/2 is called)" n + (erlang-skel-separator 2) + "handle_call(Request, From, State) ->" n> + "Reply = ok," n> + "{reply, Reply, State}." n + n + (erlang-skel-separator 2) + "%% Function: handle_cast/2" n + "%% Description: Handling cast messages" n + "%% Returns: {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, State} (terminate/2 is called)" n + (erlang-skel-separator 2) + "handle_cast(stop, State) ->" n> + "{stop, normal, State};" n + "handle_cast(Msg, State) ->" n> + "{noreply, State}." n + n + (erlang-skel-separator 2) + "%% Function: handle_info/2" n + "%% Description: Handling all non call/cast messages" n + "%% Returns: {noreply, State} |" n + "%% {noreply, State, Timeout} |" n + "%% {stop, Reason, State} (terminate/2 is called)" n + (erlang-skel-separator 2) + "handle_info(Info, State) ->" n> + "{noreply, State}." n + n + (erlang-skel-separator 2) + "%% Function: terminate/2" n + "%% Description: Shutdown the server" n + "%% Returns: any (ignored by gen_server)" n + (erlang-skel-separator 2) + "terminate(Reason, State) ->" n> + "ok." n + n + (erlang-skel-separator 2) + "%% Func: code_change/3" n + "%% Purpose: Convert process state when code is changed" n + "%% Returns: {ok, NewState}" n + (erlang-skel-separator 2) + "code_change(OldVsn, State, _E, _Extra) ->" n> + "{ok, State}." n + n + + n + (erlang-skel-separator 2) + "%%% Internal functions" n + (erlang-skel-separator 2) + ) + "*The template of a generic leader. +Please see the function `tempo-define-template'.") + + +(defvar erlang-skel-corba-callback + '((erlang-skel-include erlang-skel-large-header) + (erlang-skel-separator 2) + "%% Include files" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% External exports" n + (erlang-skel-separator 2) + "-export([" n> "init/1, " n> "terminate/2," n> "code_change/3" n + " ])." n + n + (erlang-skel-separator 2) + "%% Internal exports" n + (erlang-skel-separator 2) + "-export([" n + " ])." n + n + (erlang-skel-separator 2) + "%% Macros" n + (erlang-skel-separator 2) + n + (erlang-skel-separator 2) + "%% Records" n + (erlang-skel-separator 2) + "-record(state, {})." n + n + (erlang-skel-double-separator 2) + "%% External functions" n + (erlang-skel-double-separator 2) + (erlang-skel-separator 2) + "%% Function: init/1" n + "%% Description: Initiates the server" n + "%% Returns: {ok, State} |" n + "%% {ok, State, Timeout} |" n + "%% ignore |" n + "%% {stop, Reason}" n + (erlang-skel-separator 2) + "init([]) ->" n> + "{ok, #state{}}." n + n + (erlang-skel-separator 2) + "%% Function: terminate/2" n + "%% Description: Shutdown the server" n + "%% Returns: any (ignored by gen_server)" n + (erlang-skel-separator 2) + "terminate(Reason, State) ->" n> + "ok." n + n + (erlang-skel-separator 2) + "%% Function: code_change/3" n + "%% Description: Convert process state when code is changed" n + "%% Returns: {ok, NewState}" n + (erlang-skel-separator 2) + "code_change(OldVsn, State, Extra) ->" n> + "{ok, State}." n + n + (erlang-skel-double-separator 2) + "%% Internal functions" n + (erlang-skel-double-separator 2) + ) + "*The template of a library module. +Please see the function `tempo-define-template'.") + + + +;; Font-lock variables + +(defvar erlang-font-lock-modern-p + (cond ((>= erlang-emacs-major-version 20) t) + (erlang-xemacs-p (>= erlang-emacs-minor-version 14)) + ((= erlang-emacs-major-version 19) (>= erlang-emacs-minor-version 29)) + (t nil)) + "Non-nil when this version of Emacs uses a modern version of Font Lock. + +This is determinated by checking the version of Emacs used, the actual +font-lock code is not loaded.") + + +;; The next few variables define different Erlang font-lock patterns. +;; They could be appended to form a custom font-lock appearence. +;; +;; The function `erlang-font-lock-set-face' could be used to change +;; the face of a pattern. +;; +;; Note that Erlang strings and atoms are hightlighted with using +;; syntactix analysis. + +(defvar erlang-font-lock-keywords-func + (list + (list (concat "^" erlang-atom-regexp "\\s *(") + 1 'font-lock-function-name-face t)) + "Font lock keyword highlighting a function header.") + +(defvar erlang-font-lock-keywords-dollar + (list + (list "\\(\\$\\([^\\]\\|\\\\\\([^0-7^\n]\\|[0-7]+\\|\\^[a-zA-Z]\\)\\)\\)" + 1 'font-lock-string-face)) + "Font lock keyword highlighting numbers in ascii-form (e.g. $A).") + +(defvar erlang-font-lock-keywords-arrow + (list + (list "\\(->\\|:-\\)\\(\\s \\|$\\)" 2 'font-lock-function-name-face)) + "Font lock keyword highlighting clause arrow.") + +(defvar erlang-font-lock-keywords-lc + (list + (list "\\(<-\\)\\(\\s \\|$\\)" 1 'font-lock-keyword-face) + (list "\\(||\\)\\(\\s \\|$\\)" 1 'font-lock-keyword-face)) + "Font lock keyword highlighting list comprehension operators.") + +(defvar erlang-font-lock-keywords-keywords + (list + (list (concat "\\<\\(after\\|begin\\|c\\(atch\\|ase\\)\\|end\\|fun\\|if" + "\\|of\\|receive\\|when\\|query\\)\\([^a-zA-Z0-9_]\\|$\\)") + 1 'font-lock-keyword-face)) + "Font lock keyword highlighting Erlang keywords.") + +(defvar erlang-font-lock-keywords-attr + (list + (list (concat "^\\(-" erlang-atom-regexp "\\)\\s *\\(\\.\\|(\\)") + 1 'font-lock-function-name-face)) + "Font lock keyword highlighting attribues.") + +(defvar erlang-font-lock-keywords-quotes + (list + (list "`\\([-+a-zA-Z0-9_:*][-+a-zA-Z0-9_:*]+\\)'" + 1 + (if erlang-font-lock-modern-p + 'font-lock-reference-face + 'font-lock-keyword-face) + t)) + "Font lock keyword highlighting words in single quotes in comments. + +This is not the keyword hightlighting Erlang strings and atoms, they +are highlighted by syntactic analysis.") + +;; Note: The guard `float' collides with the bif `float'. +(defvar erlang-font-lock-keywords-guards + (list + (list + + ;; XXX: +; (concat "\\<" +; (regexp-opt '("atom" "binary" "constant" "float" "integer" "list" +; "number" "pid" "port" "reference" "record" "tuple") +; t) +; "\\>") + + (concat "\\<\\(atom\\|binary\\|constant\\|float\\|integer\\|list\\|" + "number\\|p\\(id\\|ort\\)\\|re\\(ference\\|cord\\)\\|tuple" + "\\)\\s *(") + + 1 + (if erlang-font-lock-modern-p + 'font-lock-reference-face + 'font-lock-keyword-face))) + "Font lock keyword highlighting guards.") + +(defvar erlang-font-lock-keywords-bifs + (list + (list + (concat + "\\<\\(" + "a\\(bs\\|live\\|pply\\|tom_to_list\\)\\|" + "binary_to_\\(list\\|term\\)\\|" + "concat_binary\\|d\\(ate\\|isconnect_node\\)\\|" + "e\\(lement\\|rase\\|xit\\)\\|" + "float\\(\\|_to_list\\)\\|" + "g\\(arbage_collect\\|et\\(\\|_keys\\)\\|roup_leader\\)\\|" + "h\\(alt\\|d\\)\\|" + "i\\(nte\\(ger_to_list\\|rnal_bif\\)\\|s_alive\\)\\|" + "l\\(ength\\|i\\(nk\\|st_to_\\(atom\\|binary\\|float\\|integer" + "\\|pid\\|tuple\\)\\)\\)\\|" + "make_ref\\|no\\(de\\(\\|_\\(link\\|unlink\\)\\|s\\)\\|talive\\)\\|" + "open_port\\|" + "p\\(id_to_list\\|rocess\\(_\\(flag\\|info\\)\\|es\\)\\|ut\\)\\|" + "r\\(egister\\(\\|ed\\)\\|ound\\)\\|" + "s\\(e\\(lf\\|telement\\)\\|ize\\|" + "p\\(awn\\(\\|_link\\)\\|lit_binary\\)\\|tatistics\\)\\|" + "t\\(erm_to_binary\\|hrow\\|ime\\|l\\|" + "r\\(ace\\|unc\\)\\|uple_to_list\\)\\|" + "un\\(link\\|register\\)\\|whereis" + "\\)\\s *(") + 1 + 'font-lock-keyword-face)) + "Font lock keyword highlighting built in functions.") + +(defvar erlang-font-lock-keywords-macros + (list + (list (concat "?\\s *\\(" erlang-atom-regexp + "\\|" erlang-variable-regexp "\\)\\>") + 1 (if erlang-font-lock-modern-p + 'font-lock-reference-face + 'font-lock-type-face)) + (list (concat "^-\\(define\\|ifn?def\\)\\s *(\\s *\\(" erlang-atom-regexp + "\\|" erlang-variable-regexp "\\)\\>") + 2 (if erlang-font-lock-modern-p + 'font-lock-reference-face + 'font-lock-type-face))) + "Font lock keyword highlighting macros. +This must be placed in front of `erlang-font-lock-keywords-vars'.") + +(defvar erlang-font-lock-keywords-records + (list + (list (concat "#\\s *" erlang-atom-regexp "\\>") + 1 'font-lock-type-face) + ;; Don't highlight numerical constants. + (list "\\<[0-9][0-9]?#\\([0-9a-fA_F]+\\)\\>" + 1 nil t) + (list (concat "^-record(\\s *" erlang-atom-regexp "\\>") + 1 'font-lock-type-face)) + "Font lock keyword highlighting Erlang records. +This must be placed in front of `erlang-font-lock-keywords-vars'.") + +(defvar erlang-font-lock-keywords-vars + (list + (list (concat "\\<" erlang-variable-regexp "\\>") + 1 (if erlang-font-lock-modern-p + 'font-lock-variable-name-face + 'font-lock-type-face))) + "Font lock keyword highlighting Erlang variables. +Must be preceded by `erlang-font-lock-keywords-macros' and `-records' +to work properly.") + + +(defvar erlang-font-lock-keywords-1 + (append erlang-font-lock-keywords-func + erlang-font-lock-keywords-dollar + erlang-font-lock-keywords-arrow + erlang-font-lock-keywords-keywords) + ;; DocStringOrig: erlang-font-lock-keywords + "Font-lock keywords used by Erlang Mode. + +There exists three levels of Font Lock keywords for Erlang: + `erlang-font-lock-keywords-1' - Function headers and reserved keywords. + `erlang-font-lock-keywords-2' - Bifs, guards and `singel quotes'. + `erlang-font-lock-keywords-3' - Variables, macros and records. + +To use a specific level, please set the variable +`font-lock-maximum-decoration' to the appropriate level. Note that the +variable must be set before Erlang mode is activated. + +Example: + (setq font-lock-maximum-decoration 2)") + + +(defvar erlang-font-lock-keywords-2 + (append erlang-font-lock-keywords-1 + erlang-font-lock-keywords-attr + erlang-font-lock-keywords-quotes + erlang-font-lock-keywords-guards + erlang-font-lock-keywords-bifs) + ;; DocStringCopy: erlang-font-lock-keywords + "Font-lock keywords used by Erlang Mode. + +There exists three levels of Font Lock keywords for Erlang: + `erlang-font-lock-keywords-1' - Function headers and reserved keywords. + `erlang-font-lock-keywords-2' - Bifs, guards and `single quotes'. + `erlang-font-lock-keywords-3' - Variables, macros and records. + +To use a specific level, please set the variable +`font-lock-maximum-decoration' to the appropriate level. Note that the +variable must be set before Erlang mode is activated. + +Example: + (setq font-lock-maximum-decoration 2)") + + +(defvar erlang-font-lock-keywords-3 + (append erlang-font-lock-keywords-2 + erlang-font-lock-keywords-macros + erlang-font-lock-keywords-records + erlang-font-lock-keywords-vars) + ;; DocStringCopy: erlang-font-lock-keywords + "Font-lock keywords used by Erlang Mode. + +There exists three levels of Font Lock keywords for Erlang: + `erlang-font-lock-keywords-1' - Function headers and reserved keywords. + `erlang-font-lock-keywords-2' - Bifs, guards and `single quotes'. + `erlang-font-lock-keywords-3' - Variables, macros and records. + +To use a specific level, please set the variable +`font-lock-maximum-decoration' to the appropriate level. Note that the +variable must be set before Erlang mode is activated. + +Example: + (setq font-lock-maximum-decoration 2)") + + +(defvar erlang-font-lock-keywords erlang-font-lock-keywords-3 + ;; DocStringCopy: erlang-font-lock-keywords + "Font-lock keywords used by Erlang Mode. + +There exists three levels of Font Lock keywords for Erlang: + `erlang-font-lock-keywords-1' - Function headers and reserved keywords. + `erlang-font-lock-keywords-2' - Bifs, guards and `single quotes'. + `erlang-font-lock-keywords-3' - Variables, macros and records. + +To use a specific level, please set the variable +`font-lock-maximum-decoration' to the appropriate level. Note that the +variable must be set before Erlang mode is activated. + +Example: + (setq font-lock-maximum-decoration 2)") + + +(defvar erlang-font-lock-syntax-table nil + "Syntax table used by Font Lock mode. + +The difference between this and the standard Erlang Mode +syntax table is that `_' is treated as part of words by +this syntax table. + +Unfortuantely, XEmacs hasn't got support for a special Font +Lock syntax table. The effect is that `apply' in the atom +`foo_apply' will be highlighted as a bif.") + + +;;; Avoid errors while compiling this file. + +;; `eval-when-compile' is not defined in Emacs 18. We define it as a +;; no-op. +(or (fboundp 'eval-when-compile) + (defmacro eval-when-compile (&rest rest) nil)) + +;; These umm...functions are new in Emacs 20. And, yes, until version +;; 19.27 Emacs backquotes were this ugly. + +(or (fboundp 'unless) + (defmacro unless (condition &rest body) + "(unless CONDITION BODY...): If CONDITION is false, do BODY, else return nil." + (` (if (, condition) + nil + (,@ body))))) + +(or (fboundp 'when) + (defmacro when (condition &rest body) + "(when CONDITION BODY...): If CONDITION is true, do BODY, else return nil." + (` (if (, condition) + (progn (,@ body)) + nil)))) + +(or (fboundp 'char-before) + (defmacro char-before (&optional pos) + "Return the character in the current buffer just before POS." + (` (char-after (1- (or (, pos) (point))))))) + +(or (fboundp 'regexp-opt) + (defun regexp-opt (strings &optional paren) + "Return a regular expression that matches any string in +STRINGS. If PAREN is true, it will always enclose the regular +expression in parentheses. + +Unlike its Emacs-20 namesake, it will not optimize the generated +expression." + ;; This stop-gap definition is taken from + ;; _GNU_Emacs_Lisp_Reference_Manual_, ed 2.5, for Emacs 20.3. + (let ((open (if paren "\\(" "")) + (close (if paren "\\)" ""))) + (concat open + (mapconcat 'regexp-quote strings "\\|") + close)))) + +(eval-when-compile + (if (or (featurep 'bytecomp) + (featurep 'byte-compile)) + (progn + (cond ((string-match "Lucid\\|XEmacs" emacs-version) + (put 'comment-indent-hook 'byte-obsolete-variable nil) + ;; Do not warn for unused variables + ;; when compiling under XEmacs. + (setq byte-compile-warnings + '(free-vars unresolved callargs redefine)))) + (require 'comint) + (require 'compile)))) + + +(defun erlang-version () + "Return the current version of Erlang mode." + (interactive) + (if (interactive-p) + (message "Erlang mode version %s, written by Anders Lindgren" + erlang-version)) + erlang-version) + + +;;;###autoload +(defun erlang-mode () + "Major mode for editing Erlang source files in Emacs. +It knows about syntax and comment, it can indent code, it is capable +of fontifying the source file, the TAGS commands are aware of Erlang +modules, and the Erlang man pages can be accessed. + +Should this module, \"erlang.el\", be installed properly, Erlang mode +is activated whenever an Erlang source or header file is loaded into +Emacs. To indicate this, the mode line should contain the word +\"Erlang\". + +The main feature of Erlang mode is indentation, press TAB and the +current line will be indented correctly. + +Comments starting with only one `%' are indented to the column stored +in the variable `comment-column'. Comments starting with two `%':s +are indented with the same indentation as code. Comments starting +with at least three `%':s are indented to the first column. + +However, Erlang mode contains much more, this is a list of the most +useful commands: + TAB - Indent the line. + C-c C-q - Indent current function. + M-; - Create a comment at the end of the line. + M-q - Fill a comment, i.e. wrap lines so that they (hopefully) + will look better. + M-a - Goto the beginning of an Erlang clause. + M-C-a - Ditto for function. + M-e - Goto the end of an Erlang clause. + M-C-e - Ditto for function. + M-h - Mark current Erlang clause. + M-C-h - Ditto for function. + C-c C-z - Start, or switch to, an inferior Erlang shell. + C-c C-k - Compile current file. + C-x ` - Next error. + , - Electric comma. + ; - Electric semicolon. + +Erlang mode check the name of the file against the module name when +saving, whenever a mismatch occurs Erlang mode offers to modify the +source. + +The variable `erlang-electric-commands' controls the electric +commands. To deactivate all of them, set it to nil. + +There exists a large number of commands and variables in the Erlang +module. Please press `M-x apropos RET erlang RET' to see a complete +list. Press `C-h f name-of-function RET' and `C-h v name-of-variable +RET'to see the full description of functions and variables, +respectively. + +On entry to this mode the contents of the hook `erlang-mode-hook' is +executed. + +Please see the beginning of the file `erlang.el' for more information +and examples of hooks. + +Other commands: +\\{erlang-mode-map}" + (interactive) + (kill-all-local-variables) + (setq major-mode 'erlang-mode) + (setq mode-name "Erlang") + (erlang-syntax-table-init) + (erlang-keymap-init) + (erlang-electric-init) + (erlang-menu-init) + (erlang-mode-variables) + (erlang-check-module-name-init) + (erlang-add-compilation-alist erlang-error-regexp-alist) + (erlang-man-init) + (erlang-tags-init) + (erlang-font-lock-init) + (erlang-skel-init) + (run-hooks 'erlang-mode-hook) + (if (zerop (buffer-size)) + (run-hooks 'erlang-new-file-hook))) + + +(defun erlang-syntax-table-init () + (if (null erlang-mode-syntax-table) + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\n ">" table) + (modify-syntax-entry ?\" "\"" table) + (modify-syntax-entry ?# "." table) + (modify-syntax-entry ?$ "/" table) + (modify-syntax-entry ?% "<" table) + (modify-syntax-entry ?& "." table) + (modify-syntax-entry ?\' "\"" table) + (modify-syntax-entry ?* "." table) + (modify-syntax-entry ?+ "." table) + (modify-syntax-entry ?- "." table) + (modify-syntax-entry ?/ "." table) + (modify-syntax-entry ?: "." table) + (modify-syntax-entry ?< "." table) + (modify-syntax-entry ?= "." table) + (modify-syntax-entry ?> "." table) + (modify-syntax-entry ?\\ "\\" table) + (modify-syntax-entry ?_ "_" table) + (modify-syntax-entry ?| "." table) + (modify-syntax-entry ?^ "/" table) + + ;; Pseudo bit-syntax: Latin1 double angle quotes as parens. + ;;(modify-syntax-entry ?\253 "(?\273" table) + ;;(modify-syntax-entry ?\273 ")?\253" table) + + (setq erlang-mode-syntax-table table))) + + (set-syntax-table erlang-mode-syntax-table)) + + +(defun erlang-keymap-init () + (if erlang-mode-map + nil + (setq erlang-mode-map (make-sparse-keymap)) + (erlang-mode-commands erlang-mode-map)) + (use-local-map erlang-mode-map)) + + +(defun erlang-mode-commands (map) + (define-key map "\t" 'erlang-indent-command) + (define-key map ";" 'erlang-electric-semicolon) + (define-key map "," 'erlang-electric-comma) + (define-key map "<" 'erlang-electric-lt) + (define-key map ">" 'erlang-electric-gt) + (define-key map "\C-m" 'erlang-electric-newline) + (define-key map "\177" 'backward-delete-char-untabify) + (define-key map "\M-q" 'erlang-fill-paragraph) + (define-key map "\M-\C-a" 'erlang-beginning-of-function) + (define-key map "\M-\C-e" 'erlang-end-of-function) + (define-key map "\M-\C-h" 'erlang-mark-function) + (define-key map "\M-\t" 'erlang-complete-tag) + (define-key map "\C-c\M-\t" 'tempo-complete-tag) + (define-key map "\C-c\M-a" 'erlang-beginning-of-clause) + (define-key map "\C-c\M-b" 'tempo-backward-mark) + (define-key map "\C-c\M-e" 'erlang-end-of-clause) + (define-key map "\C-c\M-f" 'tempo-forward-mark) + (define-key map "\C-c\M-h" 'erlang-mark-clause) + (define-key map "\C-c\C-c" 'comment-region) + (define-key map "\C-c\C-j" 'erlang-generate-new-clause) + (define-key map "\C-c\C-k" 'erlang-compile) + (define-key map "\C-c\C-l" 'erlang-compile-display) + (define-key map "\C-c\C-s" 'erlang-show-syntactic-information) + (define-key map "\C-c\C-q" 'erlang-indent-function) + (define-key map "\C-c\C-u" 'erlang-uncomment-region) + (define-key map "\C-c\C-y" 'erlang-clone-arguments) + (define-key map "\C-c\C-z" 'erlang-shell-display) + (define-key map "\C-x`" 'erlang-next-error)) + + +(defun erlang-electric-init () + ;; Set up electric character functions to work with + ;; delsel/pending-del mode. Also, set up text properties for bit + ;; syntax handling. + (mapcar #'(lambda (cmd) + (put cmd 'delete-selection t) ;for delsel (Emacs) + (put cmd 'pending-delete t)) ;for pending-del (XEmacs) + '(erlang-electric-semicolon + erlang-electric-comma + erlang-electric-gt)) + + (put 'bitsyntax-open-outer 'syntax-table '(4 . ?>)) + (put 'bitsyntax-open-outer 'rear-nonsticky '(category)) + (put 'bitsyntax-open-inner 'rear-nonsticky '(category)) + (put 'bitsyntax-close-inner 'rear-nonsticky '(category)) + (put 'bitsyntax-close-outer 'syntax-table '(5 . ?<)) + (put 'bitsyntax-close-outer 'rear-nonsticky '(category)) + (setq parse-sexp-lookup-properties 't)) + + + +(defun erlang-mode-variables () + (or erlang-mode-abbrev-table + (define-abbrev-table 'erlang-mode-abbrev-table ())) + (setq local-abbrev-table erlang-mode-abbrev-table) + (make-local-variable 'paragraph-start) + (setq paragraph-start (concat "^$\\|" page-delimiter)) + (make-local-variable 'paragraph-separate) + (setq paragraph-separate paragraph-start) + (make-local-variable 'paragraph-ignore-fill-prefix) + (setq paragraph-ignore-fill-prefix t) + (make-local-variable 'require-final-newline) + (setq require-final-newline t) + (make-local-variable 'defun-prompt-regexp) + (setq defun-prompt-regexp erlang-defun-prompt-regexp) + (make-local-variable 'comment-start) + (setq comment-start "%") + (make-local-variable 'comment-start-skip) + (setq comment-start-skip "%+\\s *") + (make-local-variable 'comment-column) + (setq comment-column 48) + (make-local-variable 'indent-line-function) + (setq indent-line-function 'erlang-indent-command) + (make-local-variable 'indent-region-function) + (setq indent-region-function 'erlang-indent-region) + (set (make-local-variable 'comment-indent-function) 'erlang-comment-indent) + (if (<= erlang-emacs-major-version 18) + (set (make-local-variable 'comment-indent-hook) 'erlang-comment-indent)) + (set (make-local-variable 'parse-sexp-ignore-comments) t) + (set (make-local-variable 'dabbrev-case-fold-search) nil) + (set (make-local-variable 'imenu-prev-index-position-function) + 'erlang-beginning-of-function) + (set (make-local-variable 'imenu-extract-index-name-function) + 'erlang-get-function-name) + (set (make-local-variable 'tempo-match-finder) + "[^-a-zA-Z0-9_]\\([-a-zA-Z0-9_]*\\)\\=")) + + +;; Compilation. +;; +;; The following code is compatible with the standard package `compilation', +;; making it possible to go to errors using `erlang-next-error'. +;; +;; The normal `compile' command works ofcourse. For best result, please +;; execute `make' with the `-w' flag. +;; +;; Please see the variables named `compiling-..' above. + +(defun erlang-add-compilation-alist (alist) + (require 'compile) + (cond ((boundp 'compilation-error-regexp-alist) ; Emacs 19 + (while alist + (or (assoc (car (car alist)) compilation-error-regexp-alist) + (setq compilation-error-regexp-alist + (cons (car alist) compilation-error-regexp-alist))) + (setq alist (cdr alist)))) + ((boundp 'compilation-error-regexp) + ;; Emacs 18, Only one regexp is allowed. + (funcall (symbol-function 'set) + 'compilation-error-regexp (car (car alist)))))) + +(defun erlang-font-lock-init () + "Initialize Font Lock for Erlang mode." + (or erlang-font-lock-syntax-table + (setq erlang-font-lock-syntax-table + (let ((table (copy-syntax-table erlang-mode-syntax-table))) + (modify-syntax-entry ?_ "w" table) + table))) + (set (make-local-variable 'font-lock-syntax-table) + erlang-font-lock-syntax-table) + (set (make-local-variable 'font-lock-beginning-of-syntax-function) + 'erlang-beginning-of-clause) + (make-local-variable 'font-lock-keywords) + (let ((level (cond ((boundp 'font-lock-maximum-decoration) + (symbol-value 'font-lock-maximum-decoration)) + ((boundp 'font-lock-use-maximal-decoration) + (symbol-value 'font-lock-use-maximal-decoration)) + (t nil)))) + (if (consp level) + (setq level (cdr-safe (or (assq 'erlang-mode level) + (assq t level))))) + ;; `level' can here be: + ;; A number - The fontification level + ;; nil - Use the default + ;; t - Use maximum + (cond ((eq level nil) + (set 'font-lock-keywords erlang-font-lock-keywords)) + ((eq level 1) + (set 'font-lock-keywords erlang-font-lock-keywords-1)) + ((eq level 2) + (set 'font-lock-keywords erlang-font-lock-keywords-2)) + (t + (set 'font-lock-keywords erlang-font-lock-keywords-3)))) + + ;; Modern font-locks can handle the above much more elegant: + (set (make-local-variable 'font-lock-defaults) + '((erlang-font-lock-keywords erlang-font-lock-keywords-1 + erlang-font-lock-keywords-2 erlang-font-lock-keywords-3) + nil nil ((?_ . "w")) erlang-beginning-of-clause + (font-lock-comment-start-regexp . "%") + (font-lock-mark-block-function . erlang-mark-clause)))) + + + +;; Useful when definig yout own keywords. +(defun erlang-font-lock-set-face (ks &rest faces) + "Replace the face components in a list of keywords. + +The first argument, KS, is a list of keywords. The rest of the +arguments are expressions to replace the face information with. The +first expression replaces the face of the first keyword, the second +expression the second keyword etc. + +Should an expression be nil, the face of the corresponding keyword is +not changed. + +Should fewer expressions than keywords be given, the last expression +is used for all remaining keywords. + +Normally, the expressions are just atoms representing the new face. +They could however be more complex, returning different faces in +different situations. + +This function does only handle keywords with elements on the forms: + (REGEXP NUMBER FACE) + (REGEXP NUMBER FACE OVERWRITE) + +This could be used when defining your own special font-lock setup, e.g: + +\(setq my-font-lock-keywords + (append erlang-font-lock-keywords-func + erlang-font-lock-keywords-dollar + (erlang-font-lock-set-face + erlang-font-lock-keywords-macros 'my-neon-green-face) + (erlang-font-lock-set-face + erlang-font-lock-keywords-lc 'my-deep-red 'my-light-red) + erlang-font-lock-keywords-attr)) + +For a more elaborate example, please see the beginning of the file +`erlang.el'." + (let ((res '())) + (while ks + (let* ((regexp (car (car ks))) + (number (car (cdr (car ks)))) + (new-face (if (and faces (car faces)) + (car faces) + (car (cdr (cdr (car ks)))))) + (overwrite (car (cdr (cdr (cdr (car ks)))))) + (new-keyword (list regexp number new-face))) + (if overwrite (nconc new-keyword (list overwrite))) + (setq res (cons new-keyword res)) + (setq ks (cdr ks)) + (if (and faces (cdr faces)) + (setq faces (cdr faces))))) + (nreverse res))) + + +(defun erlang-font-lock-level-0 () + ;; DocStringOrig: font-cmd + "Fontify current buffer. Level ranges from 0 (off) to 3 (Christmas Tree). + +The following fontification level exists: + 0 - No fontification + 1 - Function headers, reserved keywords, strings and comments. + 2 - Bifs, guards and `single quotes'. + 3 - Variables, macros and records. + +To automatically activate font lock mode, place the following lines +in your ~/.emacs file: + +\(defun my-erlang-mode-hook () + (cond (window-system + (font-lock-mode 1)))) +\(add-hook 'erlang-mode-hook 'my-erlang-mode-hook) +\(setq font-lock-maximum-decoration t)" + (interactive) + (font-lock-mode 0)) + + +(defun erlang-font-lock-level-1 () + ;; DocStringCopy: font-cmd + "Fontify current buffer. Level ranges from 0 (off) to 3 (Christmas Tree). + +The following fontification level exists: + 0 - No fontification + 1 - Function headers, reserved keywords, strings and comments. + 2 - Bifs, guards and `single quotes'. + 3 - Variables, macros and records. + +To automatically activate font lock mode, place the following lines +in your ~/.emacs file: + +\(defun my-erlang-mode-hook () + (cond (window-system + (font-lock-mode 1)))) +\(add-hook 'erlang-mode-hook 'my-erlang-mode-hook) +\(setq font-lock-maximum-decoration t)" + (interactive) + (require 'font-lock) + (set 'font-lock-keywords erlang-font-lock-keywords-1) + (font-lock-mode 1) + (funcall (symbol-function 'font-lock-fontify-buffer))) + + +(defun erlang-font-lock-level-2 () + ;; DocStringCopy: font-cmd + "Fontify current buffer. Level ranges from 0 (off) to 3 (Christmas Tree). + +The following fontification level exists: + 0 - No fontification + 1 - Function headers, reserved keywords, strings and comments. + 2 - Bifs, guards and `single quotes'. + 3 - Variables, macros and records. + +To automatically activate font lock mode, place the following lines +in your ~/.emacs file: + +\(defun my-erlang-mode-hook () + (cond (window-system + (font-lock-mode 1)))) +\(add-hook 'erlang-mode-hook 'my-erlang-mode-hook) +\(setq font-lock-maximum-decoration t)" + (interactive) + (require 'font-lock) + (set 'font-lock-keywords erlang-font-lock-keywords-2) + (font-lock-mode 1) + (funcall (symbol-function 'font-lock-fontify-buffer))) + + +(defun erlang-font-lock-level-3 () + ;; DocStringCopy: font-cmd + "Fontify current buffer. Level ranges from 0 (off) to 3 (Christmas Tree). + +The following fontification level exists: + 0 - No fontification + 1 - Function headers, reserved keywords, strings and comments. + 2 - Bifs, guards and `single quotes'. + 3 - Variables, macros and records. + +To automatically activate font lock mode, place the following lines +in your ~/.emacs file: + +\(defun my-erlang-mode-hook () + (cond (window-system + (font-lock-mode 1)))) +\(add-hook 'erlang-mode-hook 'my-erlang-mode-hook) +\(setq font-lock-maximum-decoration t)" + (interactive) + (require 'font-lock) + (set 'font-lock-keywords erlang-font-lock-keywords-3) + (font-lock-mode 1) + (funcall (symbol-function 'font-lock-fontify-buffer))) + + +(defun erlang-menu-init () + "Init menus for Erlang mode. + +The variable `erlang-menu-items' contain a description of the Erlang +mode menu. Normally, the list contains atoms, representing variables +bound to pieces of the menu. + +Personal extentions could be added to `erlang-menu-personal-items'. + +Should any variable describing the menu configuration, this function +should be called." + (erlang-menu-install "Erlang" erlang-menu-items erlang-mode-map t)) + + +(defun erlang-menu-install (name items keymap &optional popup) + "Install a menu on Emacs 19 or XEmacs based on an abstract description. + +NAME is the name of the menu. + +ITEMS is a list. The elements are either nil representing a horisontal +line or a list with two or three elements. The first is the name of +the menu item, the second the function to call, or a submenu, on the +same same form as ITEMS. The third optional element is an expression +which is evaluated every time the menu is displayed. Should the +expression evaluate to nil the menu item is ghosted. + +KEYMAP is the keymap to add to menu to. (When using XEmacs, the menu +will only be visible when this meny is the global, the local, or an +activated minor mode keymap.) + +If POPUP is non-nil, the menu is bound to the XEmacs `mode-popup-menu' +variable, i.e. it will popup when pressing the right mouse button. + +Please see the variable `erlang-menu-base-items'." + (cond (erlang-xemacs-p + (let ((menu (erlang-menu-xemacs name items keymap))) + ;; We add the menu to the global menubar. + ;;(funcall (symbol-function 'set-buffer-menubar) + ;; (symbol-value 'current-menubar)) + (funcall (symbol-function 'add-submenu) nil menu) + (setcdr erlang-xemacs-popup-menu (cdr menu)) + (if (and popup (boundp 'mode-popup-menu)) + (funcall (symbol-function 'set) + 'mode-popup-menu erlang-xemacs-popup-menu)))) + ((>= erlang-emacs-major-version 19) + (define-key keymap (vector 'menu-bar (intern name)) + (erlang-menu-make-keymap name items))) + (t nil))) + + +(defun erlang-menu-make-keymap (name items) + "Build a menu for Emacs 19." + (let ((menumap (funcall (symbol-function 'make-sparse-keymap) + name)) + (count 0) + id def first second third) + (setq items (reverse items)) + (while items + ;; Replace any occurence of atoms by their value. + (while (and items (atom (car items)) (not (null (car items)))) + (if (and (boundp (car items)) + (listp (symbol-value (car items)))) + (setq items (append (reverse (symbol-value (car items))) + (cdr items))) + (setq items (cdr items)))) + (setq first (car-safe (car items))) + (setq second (car-safe (cdr-safe (car items)))) + (setq third (car-safe (cdr-safe (cdr-safe (car items))))) + (cond ((null first) + (setq count (+ count 1)) + (setq id (intern (format "separator-%d" count))) + (setq def '("--" . nil))) + ((and (consp second) (eq (car second) 'lambda)) + (setq count (+ count 1)) + (setq id (intern (format "lambda-%d" count))) + (setq def (cons first second))) + ((symbolp second) + (setq id second) + (setq def (cons first second))) + (t + (setq count (+ count 1)) + (setq id (intern (format "submenu-%d" count))) + (setq def (erlang-menu-make-keymap first second)))) + (define-key menumap (vector id) def) + (if third + (put id 'menu-enable third)) + (setq items (cdr items))) + (cons name menumap))) + + +(defun erlang-menu-xemacs (name items &optional keymap) + "Build a menu for XEmacs." + (let ((res '()) + first second third entry) + (while items + ;; Replace any occurence of atoms by their value. + (while (and items (atom (car items)) (not (null (car items)))) + (if (and (boundp (car items)) + (listp (symbol-value (car items)))) + (setq items (append (reverse (symbol-value (car items))) + (cdr items))) + (setq items (cdr items)))) + (setq first (car-safe (car items))) + (setq second (car-safe (cdr-safe (car items)))) + (setq third (car-safe (cdr-safe (cdr-safe (car items))))) + (cond ((null first) + (setq res (cons "------" res))) + ((symbolp second) + (setq res (cons (vector first second (or third t)) res))) + ((and (consp second) (eq (car second) 'lambda)) + (setq res (cons (vector first (list 'call-interactively second) + (or third t)) res))) + (t + (setq res (cons (cons first + (cdr (erlang-menu-xemacs + first second))) + res)))) + (setq items (cdr items))) + (setq res (reverse res)) + ;; When adding a menu to a minor-mode keymap under Emacs 19, + ;; it disappears when the mode is disabled. The expression + ;; generated below imitates this behaviour. + ;; (This could be expressed much clearer using backquotes, + ;; but I don't want to pull in every package.) + (if keymap + (let ((expr (list 'or + (list 'eq keymap 'global-map) + (list 'eq keymap (list 'current-local-map)) + (list 'symbol-value + (list 'car-safe + (list 'rassq + keymap + 'minor-mode-map-alist)))))) + (setq res (cons ':included (cons expr res))))) + (cons name res))) + + +(defun erlang-menu-substitute (items alist) + "Substitute functions in menu described by ITEMS. + +The menu ITEMS is updated destructively. + +ALIST is list of pairs where the car is the old function and cdr the new." + (let (first second pair) + (while items + (setq first (car-safe (car items))) + (setq second (car-safe (cdr-safe (car items)))) + (cond ((null first)) + ((symbolp second) + (setq pair (and second (assq second alist))) + (if pair + (setcar (cdr (car items)) (cdr pair)))) + ((and (consp second) (eq (car second) 'lambda))) + (t + (erlang-menu-substitute second alist))) + (setq items (cdr items))))) + + +(defun erlang-menu-add-above (entry above items) + "Add menu ENTRY above menu entry ABOVE in menu ITEMS. +Do nothing if the items already should be in the menu. +Should ABOVE not be in the list, the entry is added at +the bottom of the menu. + +The new menu is returned. No guarantee is given that the original +menu is left unchanged. + +The equality test is performed by `eq'. + +Example: (erlang-menu-add-above 'my-erlang-menu-items + 'erlang-menu-man-items)" + (erlang-menu-add-below entry above items t)) + + +(defun erlang-menu-add-below (entry below items &optional above-p) + "Add menu ENTRY below menu items BELOW in the Erlang menu. +Do nothing if the items already should be in the menu. +Should BELOW not be in the list, items is added at the bottom +of the menu. + +The new menu is returned. No guarantee is given that the original +menu is left unchanged. + +The equality test is performed by `eq'. + +Example: + +\(setq erlang-menu-items + (erlang-menu-add-below 'my-erlang-menu-items + 'erlang-menu-base-items + erlang-menu-items))" + (if (memq entry items) + items ; Return the original menu. + (let ((head '()) + (done nil) + res) + (while (not done) + (cond ((null items) + (setq res (append head (list entry))) + (setq done t)) + ((eq below (car items)) + (setq res + (if above-p + (append head (cons entry items)) + (append head (cons (car items) + (cons entry (cdr items)))))) + (setq done t)) + (t + (setq head (append head (list (car items)))) + (setq items (cdr items))))) + res))) + +(defun erlang-menu-delete (entry items) + "Delete ENTRY from menu ITEMS. + +The new menu is returned. No guarantee is given that the original +menu is left unchanged." + (delq entry items)) + +;; Man code: + +(defun erlang-man-init () + "Add menus containing the manual pages of the Erlang. + +The variable `erlang-man-dirs' contains entries describing +the location of the manual pages." + (interactive) + (if erlang-man-inhibit + () + (setq erlang-menu-man-items + '(nil + ("Man - Function" erlang-man-function))) + (if erlang-man-dirs + (setq erlang-menu-man-items + (append erlang-menu-man-items + (erlang-man-make-top-menu erlang-man-dirs)))) + (setq erlang-menu-items + (erlang-menu-add-above 'erlang-menu-man-items + 'erlang-menu-version-items + erlang-menu-items)) + (erlang-menu-init))) + + +(defun erlang-man-uninstall () + "Remove the man pages from the Erlang mode." + (interactive) + (setq erlang-menu-items + (erlang-menu-delete 'erlang-menu-man-items erlang-menu-items)) + (erlang-menu-init)) + + +;; The man menu is a hierarchal structure, with the manual sections +;; at the top, described by `erlang-man-dirs'. The next level could +;; either be the manual pages if not to many, otherwise it is an index +;; menu whose submenus will contain up to `erlang-man-max-menu-size' +;; manual pages. + +(defun erlang-man-make-top-menu (dir-list) + "Create one menu entry per element of DIR-LIST. +The format is described in the documentation of `erlang-man-dirs'." + (let ((menu '()) + dir) + (while dir-list + (setq dir (cond ((nth 2 (car dir-list)) + ;; Relative to `erlang-root-dir'. + (and (stringp erlang-root-dir) + (concat erlang-root-dir (nth 1 (car dir-list))))) + (t + ;; Absolute + (nth 1 (car dir-list))))) + (if (and dir + (file-readable-p dir)) + (setq menu (cons (list (car (car dir-list)) + (erlang-man-make-middle-menu + (erlang-man-get-files dir))) + menu))) + (setq dir-list (cdr dir-list))) + ;; Should no menus be found, generate a menu item which + ;; will display a help text, when selected. + (if menu + (nreverse menu) + '(("Man Pages" + (("Error! Why?" erlang-man-describe-error))))))) + + +;; Should the menu be to long, let's split it into a number of +;; smaller menus. Warning, this code contains beatiful +;; destructive operations! +(defun erlang-man-make-middle-menu (filelist) + "Create the second level menu from FILELIST. + +Should the list be longer than `erlang-man-max-menu-size', a tree of +menus is created." + (if (<= (length filelist) erlang-man-max-menu-size) + (erlang-man-make-menu filelist) + (let ((menu '()) + (filelist (copy-sequence filelist)) + segment submenu pair) + (while filelist + (setq pair (nthcdr (- erlang-man-max-menu-size 1) filelist)) + (setq segment filelist) + (if (null pair) + (setq filelist nil) + (setq filelist (cdr pair)) + (setcdr pair nil)) + (setq submenu (erlang-man-make-menu segment)) + (setq menu (cons (list (concat (car (car submenu)) + " -- " + (car (car (reverse submenu)))) + submenu) + menu))) + (nreverse menu)))) + + +(defun erlang-man-make-menu (filelist) + "Make a leaf menu based on FILELIST." + (let ((menu '()) + item) + (while filelist + (setq item (erlang-man-make-menu-item (car filelist))) + (if item + (setq menu (cons item menu))) + (setq filelist (cdr filelist))) + (nreverse menu))) + + +(defun erlang-man-make-menu-item (file) + "Create a menu item containing the name of the man page." + (and (string-match ".*/\\([^/]+\\)\\.[^.]$" file) + (let ((page (substring file (match-beginning 1) (match-end 1)))) + (list (capitalize page) + (list 'lambda '() + '(interactive) + (list 'funcall 'erlang-man-display-function + file)))))) + + +(defun erlang-man-get-files (dir) + "Return files in directory DIR." + (directory-files dir t ".*\\.[0-9]\\'")) + + +(defun erlang-man-module (&optional module) + "Find manual page for MODULE, defaults to module of function under point. +This function is aware of imported functions." + (interactive + (list (let* ((mod (car-safe (erlang-get-function-under-point))) + (input (read-string + (format "Manual entry for module%s: " + (if (or (null mod) (string= mod "")) + "" + (format " (default %s)" mod)))))) + (if (string= input "") + mod + input)))) + (or module (setq module (car (erlang-get-function-under-point)))) + (if (or (null module) (string= module "")) + (error "No Erlang module name given")) + (let ((dir-list erlang-man-dirs) + (pat (concat "\\b" (regexp-quote module) "\\.[^.]$")) + (file nil) + file-list) + (while (and dir-list (null file)) + (setq file-list (erlang-man-get-files + (if (nth 2 (car dir-list)) + (concat erlang-root-dir (nth 1 (car dir-list))) + (nth 1 (car dir-list))))) + (while (and file-list (null file)) + (if (string-match pat (car file-list)) + (setq file (car file-list))) + (setq file-list (cdr file-list))) + (setq dir-list (cdr dir-list))) + (if file + (funcall erlang-man-display-function file) + (error "No manual page for module %s found." module)))) + + +;; Warning, the function `erlang-man-function' is a hack! +;; It links itself into the man code in a non-clean way. I have +;; choosed to keep it since it provides a very useful functionality +;; which is not possible to achive using a clean approach. +;; / AndersL + +(defvar erlang-man-function-name nil + "Name of function for last `erlang-man-function' call. +Used for commnication between `erlang-man-function' and the +patch to `Man-notify-when-ready'.") + +(defun erlang-man-function (&optional name) + "Find manual page for NAME, where NAME is module:function. +The entry for `function' is displayed. + +This function is aware of imported functions." + (interactive + (list (let* ((mod-func (erlang-get-function-under-point)) + (mod (car-safe mod-func)) + (func (nth 1 mod-func)) + (input (read-string + (format + "Manual entry for `module:func' or `module'%s: " + (if (or (null mod) (string= mod "")) + "" + (format " (default %s:%s)" mod func)))))) + (if (string= input "") + (if (and mod func) + (concat mod ":" func) + mod) + input)))) + ;; Emacs 18 doesn't provide `man'... + (condition-case nil + (require 'man) + (error nil)) + (let ((modname nil) + (funcname nil)) + (cond ((null name) + (let ((mod-func (erlang-get-function-under-point))) + (setq modname (car-safe mod-func)) + (setq funcname (nth 1 mod-func)))) + ((string-match ":" name) + (setq modname (substring name 0 (match-beginning 0))) + (setq funcname (substring name (match-end 0) nil))) + ((stringp name) + (setq modname name))) + (if (or (null modname) (string= modname "")) + (error "No Erlang module name given")) + (cond ((fboundp 'Man-notify-when-ready) + ;; Emacs 19: The man command could possibly start an + ;; asyncronous process, i.e. we must hook ourselves into + ;; the system to be activated when the man-process + ;; terminates. + (if (null funcname) + () + (erlang-man-patch-notify) + (setq erlang-man-function-name funcname)) + (condition-case nil + (erlang-man-module modname) + (error (setq erlang-man-function-name nil)))) + (t + (erlang-man-module modname) + (if funcname + (erlang-man-find-function + (or (get-buffer "*Manual Entry*") ; Emacs 18 + (current-buffer)) ; XEmacs + funcname)))))) + + +;; Should the defadvice be at the top level, the package `advice' would +;; be required. Now it is only required when this functionality +;; is used. (Emacs 19 specific.) +(defun erlang-man-patch-notify () + "Patch the function `Man-notify-when-ready' to search for function. +The variable `erlang-man-function-name' is assumed to be bound to +the function name, or to nil. + +The reason for patching a function is that under Emacs 19, the man +command is executed asynchronously." + (condition-case nil + (require 'advice) + ;; This should never happend since this is only called when + ;; running under Emacs 19. + (error (error (concat "This commands needs the package `advice', " + "please upgrade your Emacs.")))) + (require 'man) + (defadvice Man-notify-when-ready + (after erlang-Man-notify-when-ready activate) + "Sets point at the documentation of the function name in +erlang-man-function-name when the man-page is displayed." + (if erlang-man-function-name + (erlang-man-find-function (ad-get-arg 0) erlang-man-function-name)) + (setq erlang-man-function-name nil))) + + +(defun erlang-man-find-function (buf func) + "Find manual page for function in `erlang-man-function-name' in buffer BUF." + (if func + (let ((win (get-buffer-window buf))) + (if win + (progn + (set-buffer buf) + (goto-char (point-min)) + (if (re-search-forward + (concat "^[ \t]+" func " ?(") + (point-max) t) + (progn + (forward-word -1) + (set-window-point win (point))) + (message "Could not find function `%s'" func))))))) + + +(defun erlang-man-display (file) + "Display FILE as a `man' file. +This is de default manual page display function. +The variables `erlang-man-display-function' contains the function +to be used." + ;; Emacs 18 doesn't `provide' man. + (condition-case nil + (require 'man) + (error nil)) + (if file + (let ((process-environment (copy-sequence process-environment))) + (if (string-match "\\(.*\\)/man[^/]*/\\([^/]+\\)\\.[^.]$" file) + (let ((dir (substring file (match-beginning 1) (match-end 1))) + (page (substring file (match-beginning 2) (match-end 2)))) + (if (fboundp 'setenv) + (setenv "MANPATH" dir) + ;; Emacs 18 + (setq process-environment (cons (concat "MANPATH=" dir) + process-environment))) + (cond ((not (and (not erlang-xemacs-p) + (= erlang-emacs-major-version 19) + (< erlang-emacs-minor-version 29))) + (manual-entry page)) + (t + ;; Emacs 19.28 and earlier versions of 19: + ;; The manual-entry command unconditionally prompts + ;; the user :-( + (funcall (symbol-function 'Man-getpage-in-background) + page)))) + (error "Can't find man page for %s\n" file))))) + + +(defun erlang-man-describe-error () + "Describe why the manual pages weren't found." + (interactive) + (with-output-to-temp-buffer "*Erlang Man Error*" + (princ "Normally, this menu should contain Erlang manual pages. + +In order to find the manual pages, the variable `erlang-root-dir' +should be bound to the name of the directory containing the Erlang +installation. The name should not include the final slash. + +Practically, you should add a line on the following form to +your ~/.emacs, or ask your system administrator to add it to +the site init file: + (setq erlang-root-dir \"/the/erlang/root/dir/goes/here\") + +For example: + (setq erlang-root-dir \"/usr/local/erlang\") + +After installing the line, kill and restart Emacs, or restart Erlang +mode with the command `M-x erlang-mode RET'."))) + +;; Skeleton code: + +;; This code is based on the package `tempo' which is part of modern +;; Emacsen. (GNU Emacs 19.25 (?) and XEmacs 19.14.) + +(defun erlang-skel-init () + "Generate the skeleton functions and menu items. +The variable `erlang-skel' contains the name and descriptions of +all skeletons. + +The skeleton routines are based on the `tempo' package. Should this +package not be present, this function does nothing." + (interactive) + (condition-case nil + (require 'tempo) + (error t)) + (if (featurep 'tempo) + (let ((skel erlang-skel) + (menu '())) + (while skel + (cond ((null (car skel)) + (setq menu (cons nil menu))) + (t + (funcall (symbol-function 'tempo-define-template) + (concat "erlang-" (nth 1 (car skel))) + ;; The tempo template used contains an `include' + ;; function call only, hence changes to the + ;; variables describing the templates take effect + ;; immdiately. + (list (list 'erlang-skel-include (nth 2 (car skel)))) + (nth 1 (car skel))) + (setq menu (cons (erlang-skel-make-menu-item + (car skel)) menu)))) + (setq skel (cdr skel))) + (setq erlang-menu-skel-items + (list nil (list "Skeletons" (nreverse menu)))) + (setq erlang-menu-items + (erlang-menu-add-above 'erlang-menu-skel-items + 'erlang-menu-version-items + erlang-menu-items)) + (erlang-menu-init)))) + +(defun erlang-skel-make-menu-item (skel) + (let ((func (intern (concat "tempo-template-erlang-" (nth 1 skel))))) + (cond ((null (nth 3 skel)) + (list (car skel) func)) + (t + (list (car skel) + (list 'lambda '() + '(interactive) + (list 'funcall + (list 'quote (nth 3 skel)) + (list 'quote func)))))))) + +;; Functions designed to be added to the skeleton menu. +;; (Not normally used) +(defun erlang-skel-insert (func) + "Insert skeleton generated by FUNC and goto first tempo mark." + (save-excursion (funcall func)) + (funcall (symbol-function 'tempo-forward-mark))) + +(defun erlang-skel-header (func) + "Insert the header generated by FUNC at the beginning of the buffer." + (goto-char (point-min)) + (save-excursion (funcall func)) + (funcall (symbol-function 'tempo-forward-mark))) + + +;; Functions used inside the skeleton descriptions. +(defun erlang-skel-skip-blank () + (skip-chars-backward " \t") + nil) + +(defun erlang-skel-include (&rest args) + "Include a template inside another template. + +Example of use, assuming that `erlang-skel-func' is defined: + + (defvar foo-skeleton '(\"%%% New function:\" + (erlang-skel-include erlang-skel-func))) + +Techically, this function returns the `tempo' attribute`(l ...)' which +can contain other `tempo' attributes. Please see the function +`tempo-define-template' for a description of the `(l ...)' attribute." + (let ((res '()) + entry) + (while args + (setq entry (car args)) + (while entry + (setq res (cons (car entry) res)) + (setq entry (cdr entry))) + (setq args (cdr args))) + (cons 'l (nreverse res)))) + +(defun erlang-skel-separator (&optional percent) + "Return a comment separator." + (let ((percent (or percent 3))) + (concat (make-string percent ?%) + (make-string (- 70 percent) ?-) + "\n"))) + +(defun erlang-skel-double-separator (&optional percent) + "Return a comment separator." + (let ((percent (or percent 3))) + (concat (make-string percent ?%) + (make-string (- 70 percent) ?=) + "\n"))) + +(defun erlang-skel-dd-mmm-yyyy () + "Return the current date as a string in \"DD Mon YYYY\" form. +The first character of DD is space if the value is less than 10." + (let ((date (current-time-string))) + (format "%2d %s %s" + (string-to-int (substring date 8 10)) + (substring date 4 7) + (substring date -4)))) + +;; Indentation code: + +(defun erlang-indent-command (&optional whole-exp) + "Indent current line as Erlang code. +With argument, indent any additional lines of the same clause +rigidly along with this one." + (interactive "P") + (if whole-exp + ;; If arg, alwys indent this line as Erlang + ;; and shift remaining lines of clause the same amount. + (let ((shift-amt (erlang-indent-line)) + beg end) + (save-excursion + (if erlang-tab-always-indent + (beginning-of-line)) + (setq beg (point)) + (erlang-end-of-clause 1) + (setq end (point)) + (goto-char beg) + (forward-line 1) + (setq beg (point))) + (if (> end beg) + (indent-code-rigidly beg end shift-amt "\n"))) + (if (and (not erlang-tab-always-indent) + (save-excursion + (skip-chars-backward " \t") + (not (bolp)))) + (insert-tab) + (erlang-indent-line)))) + + +(defun erlang-indent-line () + "Indent current line as Erlang code. +Return the amount the indentation changed by." + (let ((pos (- (point-max) (point))) + indent beg + shift-amt) + (beginning-of-line 1) + (setq beg (point)) + (skip-chars-forward " \t") + (cond ((looking-at "%") + (setq indent (funcall comment-indent-function)) + (setq shift-amt (- indent (current-column)))) + (t + (setq indent (erlang-calculate-indent)) + (cond ((null indent) + (setq indent (current-indentation))) + ((eq indent t) + ;; This should never occur here. + (error "Erlang mode error")) + ((= (char-syntax (following-char)) ?\)) + (setq indent (1- indent)))) + (setq shift-amt (- indent (current-column))))) + (if (zerop shift-amt) + nil + (delete-region beg (point)) + (indent-to indent)) + ;; If initial point was within line's indentation, position + ;; after the indentation. Else stay at same point in text. + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos))) + shift-amt)) + + +(defun erlang-indent-region (beg end) + "Indent region of erlang code. + +This is automagically called by the user level function `indent-region'." + (interactive "r") + (save-excursion + (let ((case-fold-search nil) + (continue t) + (from-end (- (point-max) end)) + indent-point ;; The beginning of the current line + indent ;; The indent amount + state) + (goto-char beg) + (beginning-of-line) + (setq indent-point (point)) + (erlang-beginning-of-clause) + ;; Parse the Erlang code from the beginning of the clause to + ;; the beginning of the region. + (while (< (point) indent-point) + (setq state (erlang-partial-parse (point) indent-point state))) + ;; Indent every line in the region + (while continue + (goto-char indent-point) + (skip-chars-forward " \t") + (cond ((looking-at "%") + ;; Do not use our stack to help the user to customize + ;; comment indentation. + (setq indent (funcall comment-indent-function))) + ((looking-at "$") + ;; Don't indent empty lines. + (setq indent 0)) + (t + (setq indent + (save-excursion + (erlang-calculate-stack-indent (point) state))) + (cond ((null indent) + (setq indent (current-indentation))) + ((eq indent t) + ;; This should never occur here. + (error "Erlang mode error")) + ((= (char-syntax (following-char)) ?\)) + (setq indent (1- indent)))))) + (if (zerop (- indent (current-column))) + nil + (delete-region indent-point (point)) + (indent-to indent)) + ;; Find the next line in the region + (goto-char indent-point) + (save-excursion + (forward-line 1) + (setq indent-point (point))) + (if (>= from-end (- (point-max) indent-point)) + (setq continue nil) + (while (< (point) indent-point) + (setq state (erlang-partial-parse + (point) indent-point state)))))))) + + +(defun erlang-indent-current-buffer () + "Indent current buffer as Erlang code." + (interactive) + (save-excursion + (save-restriction + (widen) + (erlang-indent-region (point-min) (point-max))))) + + +(defun erlang-indent-function () + "Indent current Erlang function." + (interactive) + (save-excursion + (let ((end (progn (erlang-end-of-function 1) (point))) + (beg (progn (erlang-beginning-of-function 1) (point)))) + (erlang-indent-region beg end)))) + + +(defun erlang-indent-clause () + "Indent current Erlang clause." + (interactive) + (save-excursion + (let ((end (progn (erlang-end-of-clause 1) (point))) + (beg (progn (erlang-beginning-of-clause 1) (point)))) + (erlang-indent-region beg end)))) + + +(defmacro erlang-push (x stack) (list 'setq stack (list 'cons x stack))) +(defmacro erlang-pop (stack) (list 'setq stack (list 'cdr stack))) +;; Would much prefer to make caddr a macro but this clashes. +(defun erlang-caddr (x) (car (cdr (cdr x)))) + + +(defun erlang-calculate-indent (&optional parse-start) + "Compute appropriate indentation for current line as Erlang code. +Return nil if line starts inside string, t if in a comment." + (save-excursion + (let ((indent-point (point)) + (case-fold-search nil) + (state nil)) + (if parse-start + (goto-char parse-start) + (erlang-beginning-of-clause)) + (while (< (point) indent-point) + (setq state (erlang-partial-parse (point) indent-point state))) + (erlang-calculate-stack-indent indent-point state)))) + +(defun erlang-show-syntactic-information () + "Show syntactic information for current line." + + (interactive) + + (save-excursion + (let ((starting-point (point)) + (case-fold-search nil) + (state nil)) + (erlang-beginning-of-clause) + (while (< (point) starting-point) + (setq state (erlang-partial-parse (point) starting-point state))) + (message "%S" state)))) + + +(defun erlang-partial-parse (from to &optional state) + "Parse Erlang syntax starting at FROM until TO, with an optional STATE. +Value is list (stack token-start token-type in-what)." + (goto-char from) ; Start at the beginning + (erlang-skip-blank to) + (let ((cs (char-syntax (following-char))) + (stack (car state)) + (token (point)) + in-what) + (cond + + ;; Done: Return previous state. + ((>= token to) + (setq token (nth 1 state)) + (setq cs (nth 2 state)) + (setq in-what (nth 3 state))) + ;; Word constituent: check and handle keywords. + ((= cs ?w) + (if (looking-at "\\(end\\|after\\)[^_a-zA-Z0-9]") + ;; Must pop top icr layer, `after' will push a new + ;; layer next. + (progn + (while (and stack (eq (car (car stack)) '->)) + (erlang-pop stack)) + (if (and stack (memq (car (car stack)) '(icr begin))) + (erlang-pop stack)))) + (cond ((looking-at + "\\(if\\|case\\|receive\\|after\\)[^_a-zA-Z0-9]") + ;; Must push a new icr (if/case/receive) layer. + (erlang-push (list 'icr token (current-column)) stack)) + ((looking-at "\\(fun\\)[^_a-zA-Z0-9]") + ;; Puch a new icr layer if we are defining a `fun' + ;; expression, not when we are refering an existing + ;; function. + (if (save-excursion + (goto-char (match-end 1)) + (erlang-skip-blank to) + (eq (following-char) ?\()) + (erlang-push (list 'icr token (current-column)) stack))) + ((looking-at "\\(begin\\|query\\)[^_a-zA-Z0-9]") + (erlang-push (list 'begin token (current-column)) stack)) + ((looking-at "when[^_a-zA-Z0-9]") + (erlang-push (list 'when token (current-column)) stack))) + (forward-sexp 1)) + + ;; String: Try to skip over it. (Catch error if not complete.) + ((= cs ?\") + (condition-case nil + (progn + (forward-sexp 1) + (if (> (point) to) + (progn + (setq in-what 'string) + (goto-char to)))) + (error + (setq in-what 'string) + (goto-char to)))) + + ;; Symbol constituent, punctuation, or expression prefix? + ((memq cs '(?. ?_ ?')) + (cond + + ;; Clause end + ((= (following-char) ?\;) + (if (and stack (eq (car (car stack)) '->)) + (erlang-pop stack)) + (forward-char 1)) + + ;; Function end + ((looking-at "\\.\\(\\s \\|\n\\|\\s<\\)") + (setq stack nil) + (forward-char 1)) + + ;; Function head + ((looking-at "->\\|:-") + (if (and stack (eq (car (car stack)) 'when)) + (erlang-pop stack)) + (erlang-push (list '-> token (current-column)) stack) + (forward-char 2)) + + ;; List-comprehension divider + ((looking-at "||") + (erlang-push (list '|| token (current-column)) stack) + (forward-char 2)) + + ;; Bit-syntax open paren + ((looking-at "<<") + (erlang-push (list '\( token (current-column)) stack) + (forward-char 2)) + + ;; Bbit-syntax close paren + ((looking-at ">>") + (while (memq (car (car stack)) '(|| ->)) + (erlang-pop stack)) + (cond ((eq (car (car stack)) '\() + (erlang-pop stack)) + ((memq (car (car stack)) '(icr begin)) + (error "Missing `end'")) + (t + (error "Unbalanced parentheses"))) + (forward-char 2)) + + ;; Macro + ((= (following-char) ??) + ;; Skip over macro name and any following whitespace. + (forward-word 1) + (skip-syntax-forward "-" to) + ;; Macro might have an argument list. Skip it too. + (when (= (following-char) ?\() + (forward-list 1))) + + ;; Other punctuation: Skip over it and any following punctuation + ((= cs ?.) + ;; Skip over all characters in the operand. + (skip-syntax-forward ".")) + + ;; Other char: Skip over it. + (t + (forward-char 1)))) + + ;; Open parenthesis + ((= cs ?\() + (erlang-push (list '\( token (current-column)) stack) + (forward-char 1)) + + ;; Close parenthesis + ((= cs ?\)) + (while (memq (car (car stack)) '(|| ->)) + (erlang-pop stack)) + (cond ((eq (car (car stack)) '\() + (erlang-pop stack)) + ((memq (car (car stack)) '(icr begin)) + (error "Missing `end'")) + (t + (error "Unbalanced parenthesis"))) + (forward-char 1)) + + ;; Character quote: Skip it and the quoted char. + ((= cs ?/) + (forward-char 2)) + + ;; Character escape: Skip it and the escape sequence. + ((= cs ?\\) + (forward-char 1) + (skip-syntax-forward "w")) + + ;; Everything else + (t + (forward-char 1))) + (list stack token cs in-what))) + + +(defun erlang-calculate-stack-indent (indent-point state) + "From the given last position and state (stack) calculate indentation. +Return nil if inside string, t if in a comment." + (let* ((stack (and state (car state))) + (token (nth 1 state)) + (stack-top (and stack (car stack)))) + (cond ((null state) ;No state + 0) + ((nth 3 state) + ;; Return nil or t. + (eq (nth 3 state) 'comment)) + ((null stack) + (if (looking-at "when[^_a-zA-Z0-9]") + erlang-indent-guard + 0)) + ((eq (car stack-top) '\() + ;; Element of list, tuple or part of an expression, + (if (null erlang-argument-indent) + ;; indent to next column. + (1+ (nth 2 stack-top)) + (goto-char (nth 1 stack-top)) + (cond ((looking-at "[({]\\s *\\($\\|%\\)") + ;; Line ends with parenthesis. + (+ (erlang-indent-find-preceding-expr) + erlang-argument-indent)) + (t + ;; Indent to the same column as the first + ;; argument. + (goto-char (1+ (nth 1 stack-top))) + (skip-chars-forward " \t") + (current-column))))) + ((eq (car stack-top) 'icr) + ;; The default indentation is the column of the option + ;; directly following the keyword. (This does not apply to + ;; `case'.) Should no option be on the same line, the + ;; indentation is the indentation of the keyword + + ;; `erlang-indent-level'. + ;; + ;; `after' should be indentated to the save level as the + ;; corresponding receive. + (if (looking-at "after[^_a-zA-Z0-9]") + (nth 2 stack-top) + (save-excursion + (goto-char (nth 1 stack-top)) + (if (looking-at "case[^_a-zA-Z0-9]") + (+ (nth 2 stack-top) erlang-indent-level) + (skip-chars-forward "a-z") + (skip-chars-forward " \t") + (if (memq (following-char) '(?% ?\n)) + (+ (nth 2 stack-top) erlang-indent-level) + (current-column)))))) + ;; Real indentation, where operators create extra indentation etc. + ((memq (car stack-top) '(-> || begin)) + (goto-char (nth 1 stack-top)) + ;; Check if there is more code after the '->' on the + ;; same line. If so use this indentation as base, else + ;; use parent indentation + 2 * level as base. + (let ((off erlang-indent-level) + (skip 2)) + (cond ((null (cdr stack))) ; Top level in function. + ((eq (car stack-top) 'begin) + (setq skip 5)) + ((eq (car stack-top) '->) + (setq off (* 2 erlang-indent-level)))) + (let ((base (erlang-indent-find-base stack indent-point off skip))) + ;; Look at last thing to see how we are to move relative + ;; to the base. + (goto-char token) + (cond ((looking-at "||\\|,\\|->\\|:-") + base) + ((erlang-at-keyword) + (+ (current-column) erlang-indent-level)) + ((or (= (char-syntax (following-char)) ?.) + (erlang-at-operator)) + (+ base erlang-indent-level)) + (t + (goto-char indent-point) + (cond ((memq (following-char) '(?\( ?{)) + ;; Function application or record. + (+ (erlang-indent-find-preceding-expr) + erlang-argument-indent)) + ;; Empty line, or end; treat it as the end of + ;; the block. (Here we have a choice: should + ;; the user be forced to reindent continued + ;; lines, or should the "end" be reindented?) + ((looking-at "\\(end\\|after\\)[^_a-zA-Z0-9]\\|$") + (if (eq (car (car stack)) '->) + (erlang-pop stack)) + (if stack + (erlang-caddr (car stack)) + 0)) + ;; Avoid trating comments a continued line. + ((= (following-char) ?%) + base) + ;; Continued line (e.g. line beginning + ;; with an operator.) + (t (+ base erlang-indent-level)))))))) + ((eq (car stack-top) 'when) + (goto-char (nth 1 stack-top)) + (if (looking-at "when\\s *\\($\\|%\\)") + (progn + (erlang-pop stack) + (if (and stack (eq (nth 0 (car stack)) 'icr)) + (progn + (goto-char (nth 1 (car stack))) + (+ (nth 2 (car stack)) erlang-indent-guard + ;; receive XYZ or receive + ;; XYZ + (if (looking-at "[a-z]+\\s *\\($\\|%\\)") + erlang-indent-level + (* 2 erlang-indent-level)))) + erlang-indent-guard)) + ;; "when" is followed by code, let's indent to the same + ;; column. + (forward-char 4) ; Skip "when" + (skip-chars-forward " \t") + (current-column)))))) + + +(defun erlang-indent-find-base (stack indent-point &optional offset skip) + "Find the base column for current stack." + (or skip (setq skip 2)) + (or offset (setq offset erlang-indent-level)) + (save-excursion + (let* ((stack-top (car stack))) + (goto-char (nth 1 stack-top)) + (forward-char skip) + (if (looking-at "\\s *\\($\\|%\\)") + (progn + (if (memq (car stack-top) '(-> ||)) + (erlang-pop stack)) + ;; Take parent identation + offset, + ;; else just erlang-indent-level if no parent + (if stack + (+ (erlang-caddr (car stack)) + offset) + erlang-indent-level)) + (erlang-skip-blank indent-point) + (current-column))))) + + +;; Does not handle `begin' .. `end'. +(defun erlang-indent-find-preceding-expr () + "Return the first column of the preceding expression. +This assumes that the preceding expression is either simple +\(i.e. an atom) or parenthesized." + (save-excursion + (forward-sexp -1) + (let ((col (current-column))) + (skip-chars-backward " \t") + ;; Needed to match the colon in "'foo':'bar'". + (if (not (memq (preceding-char) '(?# ?:))) + col + (backward-char 1) + (forward-sexp -1) + (current-column))))) + + +(defun erlang-skip-blank (&optional lim) + "Skip over whitespace and comments until limit reached." + (or lim (setq lim (point-max))) + (let (stop) + (while (and (not stop) (< (point) lim)) + (cond ((= (following-char) ?%) + (skip-chars-forward "^\n" lim)) + ((= (following-char) ?\n) + (skip-chars-forward "\n" lim)) + ((looking-at "\\s ") + (if (re-search-forward "\\S " lim 'move) + (forward-char -1))) + (t + (setq stop t)))) + stop)) + +(defun erlang-at-keyword () + "Are we looking at an Erlang keyword which will increase indentation?" + (looking-at (concat "\\(when\\|if\\|fun\\|case\\|begin\\|query\\|" + "of\\|receive\\|after\\|catch\\)[^_a-zA-Z0-9]"))) + +(defun erlang-at-operator () + "Are we looking at an Erlang operator?" + (looking-at + "\\(bnot\\|div\\|mod\\|band\\|bor\\|bxor\\|bsl\\|bsr\\)[^_a-zA-Z0-9]")) + +(defun erlang-comment-indent () + "Compute erlang comment indentation. + +Used both by `indent-for-comment' and the erlang specific indentation +commands." + (cond ((looking-at "%%%") 0) + ((looking-at "%%") + (or (erlang-calculate-indent) + (current-indentation))) + (t + (save-excursion + (skip-chars-backward " \t") + (max (if (bolp) 0 (1+ (current-column))) + comment-column))))) + +;;; Erlang movement commands + +;; All commands below work as movement commands. I.e. if the point is +;; at the end of the clause, and the command `erlang-end-of-clause' is +;; executed, the point is moved to the end of the NEXT clause. (This +;; mimics the behaviour of `end-of-defun'.) +;; +;; Personally I would like to rewrite them to be "pure", and add a set +;; of movement functions, like `erlang-next-clause', +;; `erlang-previous-clause', and the same for functions. +;; +;; The current implementation makes it hopeless to use the functions as +;; subroutines in more complex commands. /andersl + +(defun erlang-beginning-of-clause (&optional arg) + "Move backward to previous start of clause. +With argument, do this that many times. +Return t unless search stops due to end of buffer." + (interactive "p") + (or arg (setq arg 1)) + (if (< arg 0) + ;; Step back to the end of the previous line, unless we are at + ;; the beginning of the buffer. The reason for this move is + ;; that the regexp below includes the last character of the + ;; previous line. + (if (bobp) + (or (looking-at "\n") + (forward-char 1)) + (forward-char -1) + (if (looking-at "\\`\n") + (forward-char 1)))) + ;; The regexp matches a function header that isn't + ;; included in a string. + (and (re-search-forward "\\(\\`\\|\\`\n\\|[^\\]\n\\)\\([a-z]\\|'\\|-\\)" + nil 'move (- arg)) + (let ((beg (match-beginning 2))) + (and beg (goto-char beg)) + t))) + +(defun erlang-end-of-clause (&optional arg) + "Move to the end of the current clause. +With argument, do this that many times." + (interactive "p") + (or arg (setq arg 1)) + (while (and (looking-at "[ \t]*[%\n]") + (zerop (forward-line 1)))) + ;; Move to the next clause. + (erlang-beginning-of-clause (- arg)) + (beginning-of-line) ;; Just to be sure... + (let ((continue t)) + (while (and (not (bobp)) continue) + (forward-line -1) + (skip-chars-forward " \t") + (if (looking-at "[%\n]") + nil + (end-of-line) + (setq continue nil))))) + +(defun erlang-mark-clause () + "Put mark at end of clause, point at beginning." + (interactive) + (push-mark (point)) + (erlang-end-of-clause 1) + ;; Sets the region. In Emacs 19 and XEmacs, we wants to activate + ;; the region. + (condition-case nil + (push-mark (point) nil t) + (error (push-mark (point)))) + (erlang-beginning-of-clause 1) + ;; The above function deactivates the mark. + (if (boundp 'deactivate-mark) + (funcall (symbol-function 'set) 'deactivate-mark nil))) + +(defun erlang-beginning-of-function (&optional arg) + "Move backward to previous start of function. +With positive argument, do this that many times. +With negative argument, search forward. + +Return t unless search stops due to end of buffer." + (interactive "p") + (or arg (setq arg 1)) + (cond + ;; Search backward + ((> arg 0) + (while (and (> arg 0) + (and (erlang-beginning-of-clause 1) + (let ((start (point)) + (name (erlang-name-of-function)) + (arity (erlang-get-function-arity))) + ;; Note: "arity" is nil for e.g. "-import", hence + ;; two "-import" clauses are not considered to + ;; be part of the same function. + (while (and (erlang-beginning-of-clause 1) + (string-equal name + (erlang-name-of-function)) + arity + (equal arity + (erlang-get-function-arity))) + (setq start (point))) + (goto-char start) + t))) + (setq arg (1- arg)))) + ;; Search forward + ((< arg 0) + (end-of-line) + (erlang-beginning-of-clause 1) + ;; Step -arg functions forward. + (while (and (< arg 0) + ;; Step one function forward, or stop if the end of + ;; the buffer was reached. Return t if we found the + ;; function. + (let ((name (erlang-name-of-function)) + (arity (erlang-get-function-arity)) + (found (erlang-beginning-of-clause -1))) + (while (and found + (string-equal name (erlang-name-of-function)) + arity + (equal arity + (erlang-get-function-arity))) + (setq found (erlang-beginning-of-clause -1))) + found)) + (setq arg (1+ arg))))) + (zerop arg)) + + +(defun erlang-end-of-function (&optional arg) + "Move forward to next end of function. + +With argument, do this that many times. +With negative argument go towards the beginning of the buffer." + (interactive "p") + (or arg (setq arg 1)) + (let ((first t)) + ;; Forward + (while (and (> arg 0) (< (point) (point-max))) + (let ((pos (point))) + (while (progn + (if (and first + (progn + (forward-char 1) + (erlang-beginning-of-clause 1))) + nil + (or (bobp) (forward-char -1)) + (erlang-beginning-of-clause -1)) + (setq first nil) + (erlang-pass-over-function) + (skip-chars-forward " \t") + (if (looking-at "[%\n]") + (forward-line 1)) + (<= (point) pos)))) + (setq arg (1- arg))) + ;; Backward + (while (< arg 0) + (let ((pos (point))) + (erlang-beginning-of-clause 1) + (erlang-pass-over-function) + (forward-line 1) + (if (>= (point) pos) + (if (erlang-beginning-of-function 2) + (progn + (erlang-pass-over-function) + (skip-chars-forward " \t") + (if (looking-at "[%\n]") + (forward-line 1))) + (goto-char (point-min))))) + (setq arg (1+ arg))))) + +(defun erlang-mark-function () + "Put mark at end of function, point at beginning." + (interactive) + (push-mark (point)) + (erlang-end-of-function 1) + ;; Sets the region. In Emacs 19 and XEmacs, we wants to activate + ;; the region. + (condition-case nil + (push-mark (point) nil t) + (error (push-mark (point)))) + (erlang-beginning-of-function 1) + ;; The above function deactivates the mark. + (if (boundp 'deactivate-mark) + (funcall (symbol-function 'set) 'deactivate-mark nil))) + +(defun erlang-pass-over-function () + (while (progn + (erlang-skip-blank) + (and (not (looking-at "\\.\\(\\s \\|\n\\|\\s<\\)")) + (not (eobp)))) + (forward-sexp 1)) + (if (not (eobp)) + (forward-char 1))) + +(defun erlang-name-of-function () + (save-excursion + ;; Skip over attribute leader. + (if (looking-at "-[ \t]*") + (re-search-forward "-[ \t]*" nil 'move)) + (let ((start (point))) + (forward-sexp 1) + (buffer-substring start (point))))) + + +;;; Miscellaneous + +(defun erlang-fill-paragraph (&optional justify) + "Like \\[fill-paragraph], but handle Erlang comments. +If any of the current line is a comment, fill the comment or the +paragraph of it that point is in, preserving the comment's indentation +and initial `%':s." + (interactive "P") + (let ((has-comment nil) + ;; If has-comment, the appropriate fill-prefix for the comment. + comment-fill-prefix) + ;; Figure out what kind of comment we are looking at. + (save-excursion + (beginning-of-line) + (cond + ;; Find the command prefix. + ((looking-at (concat "\\s *" comment-start-skip)) + (setq has-comment t) + (setq comment-fill-prefix (buffer-substring (match-beginning 0) + (match-end 0)))) + ;; A line with some code, followed by a comment? Remember that the + ;; % which starts the comment shouldn't be part of a string or + ;; character. + ((progn + (while (not (looking-at "%\\|$")) + (skip-chars-forward "^%\n\"\\\\") + (cond + ((eq (char-after (point)) ?\\) (forward-char 2)) + ((eq (char-after (point)) ?\") (forward-sexp 1)))) + (looking-at comment-start-skip)) + (setq has-comment t) + (setq comment-fill-prefix + (concat (make-string (current-column) ? ) + (buffer-substring (match-beginning 0) (match-end 0))))))) + (if (not has-comment) + (fill-paragraph justify) + ;; Narrow to include only the comment, and then fill the region. + (save-restriction + (narrow-to-region + ;; Find the first line we should include in the region to fill. + (save-excursion + (while (and (zerop (forward-line -1)) + (looking-at "^\\s *%"))) + ;; We may have gone to far. Go forward again. + (or (looking-at "^\\s *%") + (forward-line 1)) + (point)) + ;; Find the beginning of the first line past the region to fill. + (save-excursion + (while (progn (forward-line 1) + (looking-at "^\\s *%"))) + (point))) + ;; Lines with only % on them can be paragraph boundaries. + (let ((paragraph-start (concat paragraph-start "\\|^[ \t%]*$")) + (paragraph-separate (concat paragraph-start "\\|^[ \t%]*$")) + (fill-prefix comment-fill-prefix)) + (fill-paragraph justify)))))) + + +(defun erlang-uncomment-region (beg end) + "Uncomment all commented lines in the region." + (interactive "r") + (comment-region beg end -1)) + + +(defun erlang-generate-new-clause () + "Create additional Erlang clause header. + +Parses the source file for the name of the current Erlang function. +Create the header containing the name, A pair of parentheses, +and an arrow. The space between the function name and the +first parenthesis is preserved. The point is placed between +the parentheses." + (interactive) + (let ((name (save-excursion + (and (erlang-beginning-of-clause) + (erlang-get-function-name t)))) + (arrow (save-excursion + (and (erlang-beginning-of-clause) + (erlang-get-function-arrow))))) + (if (or (null arrow) (null name)) + (error "Can't find name of current Erlang function.")) + (if (and (bolp) (eolp)) + nil + (end-of-line) + (newline)) + (insert name) + (save-excursion + (insert (concat ") " arrow))) + (if erlang-new-clause-with-arguments + (erlang-clone-arguments)))) + + +(defun erlang-clone-arguments () + "Insert, at the point, the argument list of the previous clause. + +The mark is set at the beginning of the inserted text, the point +at the end." + (interactive) + (let ((args (save-excursion + (beginning-of-line) + (and (erlang-beginning-of-clause) + (erlang-get-function-arguments)))) + (p (point))) + (if (null args) + (error "Can't clone argument list.")) + (insert args) + (set-mark p))) + +;;; Information retreival functions. + +(defun erlang-buffer-substring (beg end) + "Like `buffer-substring-no-properties'. +Although, this function works on all versions of Emacs." + (if (fboundp 'buffer-substring-no-properties) + (funcall (symbol-function 'buffer-substring-no-properties) beg end) + (buffer-substring beg end))) + + +(defun erlang-get-module () + "Return the name of the module as specified by `-module'. + +Return nil if file contains no `-module' attribute." + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (let ((md (match-data))) + (unwind-protect + (if (re-search-forward + (concat "^-module\\s *(\\s *\\(\\(" + erlang-atom-regexp + "\\)?\\)\\s *)\\s *\\.") + (point-max) t) + (erlang-remove-quotes + (erlang-buffer-substring (match-beginning 1) + (match-end 1))) + nil) + (store-match-data md)))))) + + +(defun erlang-get-module-from-file-name (&optional file) + "Extract the module name from a file name. + +First, the directory part is removed. Second, the part of the file name +matching `erlang-file-name-extension-regexp' is removed. + +Should the match fail, nil is returned. + +By modifying `erlang-file-name-extension-regexp' to match files other +than Erlang source files, Erlang specific functions could be applied on +non-Erlang files. Most notably; the support for Erlang modules in the +tags system could be used by files written in other languages." + (or file (setq file buffer-file-name)) + (if (null file) + nil + (setq file (file-name-nondirectory file)) + (if (string-match erlang-file-name-extension-regexp file) + (substring file 0 (match-beginning 0)) + nil))) + + +;; Used by `erlang-get-export' and `erlang-get-import'. + +(defun erlang-get-function-arity-list () + "Parses list of `function/arity' as used by `-import' and `-export'. + +The point must be placed at before the opening bracket. When the +function returns the point will be placed after the closing bracket. + +The function does not return an error if the list is incorrectly +formatted. + +Return list of (function . arity). The order of the returned list +corresponds to the order of the parsed Erlang list." + (let ((res '())) + (erlang-skip-blank) + (forward-char 1) + (if (not (eq (preceding-char) ?\[)) + '() ; Not looking at an Erlang list. + (while ; Note: `while' has no body. + (progn + (erlang-skip-blank) + (and (looking-at (concat erlang-atom-regexp + "/\\([0-9]+\\)\\>")) + (progn + (setq res (cons + (cons + (erlang-remove-quotes + (erlang-buffer-substring + (match-beginning 1) (match-end 1))) + (string-to-int + (erlang-buffer-substring + (match-beginning + (+ 1 erlang-atom-regexp-matches)) + (match-end + (+ 1 erlang-atom-regexp-matches))))) + res)) + (goto-char (match-end 0)) + (erlang-skip-blank) + (forward-char 1) + ;; Test if there are more exported functions. + (eq (preceding-char) ?,)))))) + (nreverse res))) + + +;;; Note that `-export' and the open parenthesis must be written on +;;; the same line. + +(defun erlang-get-export () + "Return a list of `(function . arity)' as specified by `-export'." + (save-excursion + (goto-char (point-min)) + (let ((md (match-data)) + (res '())) + (unwind-protect + (progn + (while (re-search-forward "^-export\\s *(" (point-max) t) + (erlang-skip-blank) + (setq res (nconc res (erlang-get-function-arity-list)))) + res) + (store-match-data md))))) + + +(defun erlang-get-import () + "Parse an Erlang source file for imported functions. + +Return an alist with module name as car part and list of conses containing +function and arity as cdr part." + (save-excursion + (goto-char (point-min)) + (let ((md (match-data)) + (res '())) + (unwind-protect + (progn + (while (re-search-forward "^-import\\s *(" (point-max) t) + (erlang-skip-blank) + (if (looking-at erlang-atom-regexp) + (let ((module (erlang-remove-quotes + (erlang-buffer-substring + (match-beginning 0) + (match-end 0))))) + (goto-char (match-end 0)) + (erlang-skip-blank) + (if (eq (following-char) ?,) + (progn + (forward-char 1) + (erlang-skip-blank) + (let ((funcs (erlang-get-function-arity-list)) + (pair (assoc module res))) + (if pair + (setcdr pair (nconc (cdr pair) funcs)) + (setq res (cons (cons module funcs) + res))))))))) + (nreverse res)) + (store-match-data md))))) + + +(defun erlang-get-function-name (&optional arg) + "Return name of current function, or nil. + +If optional argument is non-nil, everything up to and including +the first `(' is returned. + +Normally used in conjuction with `erlang-beginning-of-clause', e.g.: + (save-excursion + (if (not (eobp)) (forward-char 1)) + (and (erlang-beginning-of-clause) + (erlang-get-function-name t)))" + (let ((n (if arg 0 1))) + (and (looking-at (concat "^" erlang-atom-regexp "\\s *(")) + (erlang-buffer-substring (match-beginning n) (match-end n))))) + + +(defun erlang-get-function-arrow () + "Return arrow of current function, could be \"->\", \":-\" or nil. + +The \":-\" arrow is used by mnesia queries. + +Normally used in conjuction with `erlang-beginning-of-clause', e.g.: + (save-excursion + (if (not (eobp)) (forward-char 1)) + (and (erlang-beginning-of-clause) + (erlang-get-function-arrow)))" + (and (looking-at (concat "^" erlang-atom-regexp "\\s *\\((\\)")) + (condition-case () + (save-excursion + (goto-char (match-beginning (+ 1 erlang-atom-regexp-matches))) + (forward-sexp 1) + (erlang-skip-blank) + (and (looking-at "->\\|:-") + (erlang-buffer-substring + (match-beginning 0) (match-end 0))))))) + + +(defun erlang-get-function-arity () + "Return the number of arguments of function at point, or nil." + (and (looking-at (concat "^" erlang-atom-regexp "\\s *(")) + (save-excursion + (goto-char (match-end 0)) + (condition-case nil + (let ((res 0) + (cont t)) + (while cont + (cond ((eobp) + (setq res nil) + (setq cont nil)) + ((looking-at "\\s *)") + (setq cont nil)) + ((looking-at "\\s *\\($\\|%\\)") + (forward-line 1)) + ((looking-at "\\s *,") + (goto-char (match-end 0))) + (t + (setq res (+ 1 res)) + (forward-sexp 1)))) + res) + (error nil))))) + + +(defun erlang-get-function-arguments () + "Return arguments of current function, or nil." + (if (not (looking-at (concat "^" erlang-atom-regexp "\\s *("))) + nil + (save-excursion + (condition-case nil + (let ((start (match-end 0))) + (goto-char (- start 1)) + (forward-sexp) + (erlang-buffer-substring start (- (point) 1))) + (error nil))))) + + +(defun erlang-get-function-under-point () + "Return the module and function under the point, or nil. + +Should no explicit module name be present at the point, the +list of imported functions is searched. + +The following could be retured: + (\"module\" \"function\") -- Both module and function name found. + (nil \"function\") -- No module name was found. + nil -- No function name found + +In the future the list may contain more elements." + (save-excursion + (let ((md (match-data)) + (res nil)) + (if (eq (char-syntax (following-char)) ? ) + (skip-chars-backward " \t")) + (skip-chars-backward "a-zA-Z0-9_:'") + (cond ((looking-at (concat erlang-atom-regexp ":" erlang-atom-regexp)) + (setq res (list + (erlang-remove-quotes + (erlang-buffer-substring + (match-beginning 1) (match-end 1))) + (erlang-remove-quotes + (erlang-buffer-substring + (match-beginning (1+ erlang-atom-regexp-matches)) + (match-end (1+ erlang-atom-regexp-matches))))))) + ((looking-at erlang-atom-regexp) + (let ((fk (erlang-remove-quotes + (erlang-buffer-substring + (match-beginning 0) (match-end 0)))) + (mod nil) + (imports (erlang-get-import))) + (while (and imports (null mod)) + (if (assoc fk (cdr (car imports))) + (setq mod (car (car imports))) + (setq imports (cdr imports)))) + (setq res (list mod fk))))) + (store-match-data md) + res))) + + +;; TODO: Escape single quotes inside the string. +(defun erlang-add-quotes-if-needed (str) + "Return STR, possibly with quotes." + (if (and (stringp str) + (not (string-match (concat "\\`" erlang-atom-regexp "\\'") str))) + (concat "'" str "'") + str)) + + +(defun erlang-remove-quotes (str) + "Return STR without quotes, if present." + (let ((md (match-data))) + (prog1 + (if (string-match "\\`'\\(.*\\)'\\'" str) + (substring str (match-beginning 1) (match-end 1)) + str) + (store-match-data md)))) + + +;;; Check module name + +;; I don't want to use `advice' since it is not part of Emacs 18. +;; +;; The function `write-file', bound to C-x C-w, calls +;; `set-visited-file-name' which clears the hook. :-( +;; To make sure that the hook always is present, we add a piece of +;; code to the function `set-visited-file-name'. +(defun erlang-check-module-name-init () + "Initialize the functionality to compare file and module names. + +We redefines the function `set-visited-file-name' since it clears +the variable `local-write-file-hooks'. The original function definition +is stored in `erlang-orig-set-visited-file-name'." + (if (fboundp 'erlang-orig-set-visited-file-name) + () + (fset 'erlang-orig-set-visited-file-name + (symbol-function 'set-visited-file-name)) + (defun set-visited-file-name (&rest args) + "Please see the function `erlang-orig-set-visited-file-name'." + (interactive "FSet visited file name: ") + (apply (symbol-function 'erlang-orig-set-visited-file-name) args) + (if (eq major-mode 'erlang-mode) + (add-hook 'local-write-file-hooks 'erlang-check-module-name)))) + (add-hook 'local-write-file-hooks 'erlang-check-module-name)) + + +(defun erlang-check-module-name () + "If the module name doesn't match file name, ask for permission to change. + +The variable `erlang-check-module-name' controls the behaviour of this +function. It it is nil, this function does nothing. If it is t, the +source is silently changed. If it is set to the atom `ask', the user +is prompted. + +This function is normally placed in the hook `local-write-file-hook'." + (if erlang-check-module-name + (let ((mn (erlang-get-module)) + (fn (erlang-get-module-from-file-name (buffer-file-name)))) + (if (and (stringp mn) (stringp fn)) + (or (string-equal mn fn) + (if (or (eq erlang-check-module-name t) + (y-or-n-p + "Module does not match file name. Modify source? ")) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (if (re-search-forward + (concat "^-module\\s *(\\s *\\(\\(" + erlang-atom-regexp + "\\)?\\)\\s *)\\s *\\.") + (point-max) t) + (progn + (goto-char (match-beginning 1)) + (delete-region (match-beginning 1) + (match-end 1)) + (insert fn)))))))))) + ;; Must return nil since it is added to `local-write-file-hook'. + nil) + + +;;; Electric functions. + +(defun erlang-electric-semicolon (&optional arg) + "Insert a semicolon character and possibly a prototype for the next line. + +The variable `erlang-electric-semicolon-criteria' states a critera, +when fulfilled a newline is inserted, the next line is indented and a +prototype for the next line is inserted. Normally the prototype +consists of \" ->\". Should the semicolon end the clause a new clause +header is generated. + +The variable `erlang-electric-semicolon-insert-blank-lines' controls +the number of blank lines inserted between the current line and new +function header. + +Behaves just like the normal semicolon when supplied with a +numerical arg, point is inside string or comment, or when there are +non-whitespace characters following the point on the current line." + (interactive "P") + (self-insert-command (prefix-numeric-value arg)) + (if (or arg + (and (listp erlang-electric-commands) + (not (memq 'erlang-electric-semicolon + erlang-electric-commands))) + (erlang-in-literal) + (not (looking-at "\\s *\\(%.*\\)?$")) + (null (erlang-test-criteria-list + erlang-electric-semicolon-criteria))) + (setq erlang-electric-newline-inhibit nil) + (setq erlang-electric-newline-inhibit t) + (undo-boundary) + (end-of-line) + (newline) + (if (condition-case nil + (progn (erlang-indent-line) t) + (error (if (bolp) (delete-backward-char 1)))) + (if (not (bolp)) + (save-excursion + (insert " ->")) + (condition-case nil + (progn + (erlang-generate-new-clause) + (if erlang-electric-semicolon-insert-blank-lines + (save-excursion + (beginning-of-line) + (newline + erlang-electric-semicolon-insert-blank-lines)))) + (error (if (bolp) (delete-backward-char 1)))))))) + + +(defun erlang-electric-comma (&optional arg) + "Insert a comma character and possibly a new indented line. +The variable `erlang-electric-comma-criteria' states a critera, +when fulfilled a newline is inserted and the next line is indeted. + +Behaves just like the normal comma when supplied with a +numerical arg, point is inside string or comment, or when there are +non-whitespace characters following the point on the current line." + (interactive "P") + + (self-insert-command (prefix-numeric-value arg)) + + (if (or arg + (and (listp erlang-electric-commands) + (not (memq 'erlang-electric-comma erlang-electric-commands))) + (erlang-in-literal) + (not (looking-at "\\s *\\(%.*\\)?$")) + (null (erlang-test-criteria-list + erlang-electric-comma-criteria))) + (setq erlang-electric-newline-inhibit nil) + (setq erlang-electric-newline-inhibit t) + (undo-boundary) + (end-of-line) + (newline) + (condition-case nil + (erlang-indent-line) + (error (if (bolp) (delete-backward-char 1)))))) + +(defun erlang-electric-lt (&optional arg) + "Insert a less-than sign, and optionally mark it as an open paren." + + (interactive "p") + + (self-insert-command arg) + + ;; Was this the second char in bit-syntax open (`<<')? + (unless (< (point) 2) + (save-excursion + (backward-char 2) + (when (and (eq (char-after (point)) ?<) + (not (eq (get-text-property (point) 'category) + 'bitsyntax-open-inner))) + ;; Then mark the two chars... + (put-text-property (point) (1+ (point)) + 'category 'bitsyntax-open-outer) + (forward-char 1) + (put-text-property (point) (1+ (point)) + 'category 'bitsyntax-open-inner) + ;;...and unmark any subsequent less-than chars. + (forward-char 1) + (while (eq (char-after (point)) ?<) + (remove-text-properties (point) (1+ (point)) + '(category nil)) + (forward-char 1)))))) + +(defun erlang-after-bitsyntax-close () + "Returns true if point is placed immediately after a bit-syntax close parenthesis (`>>')." + (and (>= (point) 2) + (save-excursion + (backward-char 2) + (and (eq (char-after (point)) ?>) + (not (eq (get-text-property (point) 'category) + 'bitsyntax-close-outer)))))) + +(defun erlang-after-arrow () + "Returns true if point is placed immediately after a function arrow (`->')." + (and (>= (point) 2) + (and + (save-excursion + (backward-char) + (eq (char-before (point)) ?-)) + (or (not (listp erlang-electric-commands)) + (memq 'erlang-electric-gt + erlang-electric-commands)) + (not (erlang-in-literal)) + (looking-at "\\s *\\(%.*\\)?$") + (erlang-test-criteria-list erlang-electric-arrow-criteria)))) + + +(defun erlang-electric-gt (&optional arg) + "Insert a greater-than sign, and optionally mark it as a close paren." + + (interactive "p") + + (self-insert-command arg) + + (cond + ;; Did we just write a bit-syntax close (`>>')? + ((erlang-after-bitsyntax-close) + (save-excursion + ;; Then mark the two chars... + (backward-char 2) + (put-text-property (point) (1+ (point)) + 'category 'bitsyntax-close-inner) + (forward-char) + (put-text-property (point) (1+ (point)) + 'category 'bitsyntax-close-outer) + ;;...and unmark any subsequent greater-than chars. + (forward-char) + (while (eq (char-after (point)) ?>) + (remove-text-properties (point) (1+ (point)) + '(category nil)) + (forward-char)))) + + ;; Did we just write a function arrow (`->')? + ((erlang-after-arrow) + (let ((erlang-electric-newline-inhibit t)) + (undo-boundary) + (end-of-line) + (newline) + (condition-case nil + (erlang-indent-line) + (error (if (bolp) (delete-backward-char 1)))))) + + ;; Then it's just a plain greater-than. + (t + nil))) + + +(defun erlang-electric-arrow\ off (&optional arg) + "Insert a '>'-sign and possible a new indented line. + +This command is only `electric' when the `>' is part of an `->' arrow. +The variable `erlang-electric-arrow-criteria' states a sequence of +criteria, which decides when a newline should be inserted and the next +line indented. + +It behaves just like the normal greater than sign when supplied with a +numerical arg, point is inside string or comment, or when there are +non-whitespace characters following the point on the current line. + +After being split/merged into erlang-after-arrow and +erlang-electric-gt, it is now unused and disabled." + (interactive "P") + (let ((prec (preceding-char))) + (self-insert-command (prefix-numeric-value arg)) + (if (or arg + (and (listp erlang-electric-commands) + (not (memq 'erlang-electric-arrow + erlang-electric-commands))) + (not (eq prec ?-)) + (erlang-in-literal) + (not (looking-at "\\s *\\(%.*\\)?$")) + (null (erlang-test-criteria-list + erlang-electric-arrow-criteria))) + (setq erlang-electric-newline-inhibit nil) + (setq erlang-electric-newline-inhibit t) + (undo-boundary) + (end-of-line) + (newline) + (condition-case nil + (erlang-indent-line) + (error (if (bolp) (delete-backward-char 1))))))) + + +(defun erlang-electric-newline (&optional arg) + "Break line at point and indent, continuing comment if within one. +The variable `erlang-electric-newline-criteria' states a critera, +when fulfilled a newline is inserted and the next line is indeted. + +Should the current line begin with a comment, and the variable +`comment-multi-line' be non-nil, a new comment start is inserted. + +Should the previous command be another electric command we assume that +the user pressed newline out of old habit, hence we will do nothing." + (interactive "P") + (cond ((and (not arg) + erlang-electric-newline-inhibit + (memq last-command erlang-electric-newline-inhibit-list)) + ()) ; Do nothing! + ((or arg + (and (listp erlang-electric-commands) + (not (memq 'erlang-electric-newline + erlang-electric-commands))) + (null (erlang-test-criteria-list + erlang-electric-newline-criteria))) + (newline (prefix-numeric-value arg))) + (t + (if (and comment-multi-line + (save-excursion + (beginning-of-line) + (looking-at (concat "\\s *" comment-start-skip)))) + (let ((str (buffer-substring + (or (match-end 1) (match-beginning 0)) + (min (match-end 0) (point))))) + (newline) + (undo-boundary) + (insert str)) + (newline) + (undo-boundary) + (indent-according-to-mode))))) + + +(defun erlang-test-criteria-list (criteria) + "Given a list of criteria functions, test if criteria is fulfilled. + +Each element in the criteria list can a function returning nil, t or +the atom `stop'. t means that the criteria is fulfilled, `stop' means +that it the criteria isn't fulfilled and that the search should stop, +and nil means continue searching. + +Should the list contain the atom t the criteria is assumed to be +fulfilled, unless preceded by a function returning `stop', of course. + +Should the argument be the atom t instead of a list, the criteria is +assumed to be trivially true. + +Should all function return nil, the criteria is assumed not to be +fulfilled. + +Return t if criteria fulfilled, nil otherwise." + (if (eq criteria t) + t + (save-excursion + (let ((answer nil)) + (while (and criteria (null answer)) + (if (eq (car criteria) t) + (setq answer t) + (setq answer (funcall (car criteria)))) + (setq criteria (cdr criteria))) + (if (and answer (not (eq answer 'stop))) + t + nil))))) + + +(defun erlang-in-literal (&optional lim) + "Test if point is in string, quoted atom or comment. + +Return one of the three atoms `atom', `string', and `comment'. +Should the point be inside none of the above mentioned types of +context, nil is returned." + (save-excursion + (let* ((lim (or lim (save-excursion + (erlang-beginning-of-clause) + (point)))) + (state (parse-partial-sexp lim (point)))) + (cond + ((eq (nth 3 state) ?') 'atom) + ((nth 3 state) 'string) + ((nth 4 state) 'comment) + (t nil))))) + + +(defun erlang-at-end-of-function-p () + "Test if point is at end of an Erlang function. + +This function is designed to be a member of a criteria list." + (eq (save-excursion (erlang-skip-blank) (point)) + (save-excursion + (erlang-beginning-of-function -1) (point)))) + + +(defun erlang-stop-when-inside-argument-list () + "Return `stop' if inside parenthesis list, nil otherwise. + +Knows about the list comprehension syntax. When the point is +after `||', `stop' is not returned. + +This function is designed to be a member of a criteria list." + (save-excursion + (condition-case nil + (let ((orig-point (point)) + (state nil)) + (up-list -1) + (if (not (eq (following-char) ?\[)) + 'stop + ;; Do not return `stop' when inside a list comprehension + ;; construnction. (The point must be after `||'). + (while (< (point) orig-point) + (setq state (erlang-partial-parse (point) orig-point state))) + (if (and (car state) (eq (car (car (car state))) '||)) + nil + 'stop))) + (error + nil)))) + + +(defun erlang-stop-when-at-guard () + "Return `stop' when at function guards. + +This function is designed to be a member of a criteria list." + (save-excursion + (beginning-of-line) + (if (and (looking-at (concat "^" erlang-atom-regexp "\\s *(")) + (not (looking-at + (concat "^" erlang-atom-regexp ".*\\(->\\|:-\\)")))) + 'stop + nil))) + + +(defun erlang-next-lines-empty-p () + "Return non-nil if next lines are empty. + +The variable `erlang-next-lines-empty-threshold' contains the number +of lines required to be empty. + +A line containing only spaces and tabs is considered empty. + +This function is designed to be a member of a criteria list." + (and erlang-next-lines-empty-threshold + (save-excursion + (let ((left erlang-next-lines-empty-threshold) + (cont t)) + (while (and cont (> left 0)) + (forward-line 1) + (setq cont (looking-at "\\s *$")) + (setq left (- left 1))) + cont)))) + + +(defun erlang-at-keyword-end-p () + "Test if next readable token is the keyword end. + +This function is designed to be a member of a criteria list." + (save-excursion + (erlang-skip-blank) + (looking-at "end[^_a-zA-Z0-9]"))) + + +;; Erlang tags support which is aware of erlang modules. +;; +;; Not yet implemented under XEmacs. (Hint: The Emacs 19 etags +;; package work under XEmacs.) + +(eval-when-compile + (if (or (featurep 'bytecomp) + (featurep 'byte-compile)) + (progn + (require 'etags)))) + + +;; Variables: + +(defvar erlang-tags-function-alist + '((find-tag . erlang-find-tag) + (find-tag-other-window . erlang-find-tag-other-window) + (find-tag-regexp . erlang-find-tag-regexp) + (find-tag-other-frame . erlang-find-tag-other-frame)) + "Alist of old tags commands and the replacement functions.") + +(defvar erlang-tags-installed nil + "Non-nil when the Erlang tags system is installed.") +(defvar erlang-tags-file-list '() + "List of files in tag list. Used when finding tag on form `module:'.") +(defvar erlang-tags-completion-table nil + "Like `tags-completion-table', this table contains `tag' and `module:tag'.") +(defvar erlang-tags-buffer-installed-p nil + "Non-nil when erlang module recognising functions installed.") +(defvar erlang-tags-buffer-list '() + "Temporary list of buffers.") +(defvar erlang-tags-orig-completion-table nil + "Temporary storage for `tags-completion-table'.") +(defvar erlang-tags-orig-tag-order nil + "Temporary storage for `find-tag-tag-order'.") +(defvar erlang-tags-orig-regexp-tag-order nil + "Temporary storage for `find-tag-regexp-tag-order'.") +(defvar erlang-tags-orig-search-function nil + "Temporary storage for `find-tag-search-function'.") +(defvar erlang-tags-orig-regexp-search-function nil + "Temporary storage for `find-tag-regexp-search-function'.") +(defvar erlang-tags-orig-format-hooks nil + "Temporary storage for `tags-table-format-hooks'.") + +(defun erlang-tags-init () + "Install an alternate version of tags, aware of Erlang modules. + +After calling this function, the tags functions are aware of +Erlang modules. Tags can be entered on the for `module:tag' aswell +as on the old form `tag'. + +In the completion list, `module:tag' and `module:' shows up. + +Call this function from an appropriate init file, or add it to +Erlang mode hook with the commands: + (add-hook 'erlang-mode-hook 'erlang-tags-init) + (add-hook 'erlang-shell-mode-hook 'erlang-tags-init) + +This function only works under Emacs 18 and Emacs 19. Currently, It +is not implemented under XEmacs. (Hint: The Emacs 19 etags module +works under XEmacs.)" + (interactive) + (cond ((= erlang-emacs-major-version 18) + (require 'tags) + (erlang-tags-define-keys (current-local-map)) + (setq erlang-tags-installed t)) + (t + (require 'etags) + ;; Test on a function available in the Emacs 19 version + ;; of tags but not in the XEmacs version. + (if (not (fboundp 'find-tag-noselect)) + () + (erlang-tags-define-keys (current-local-map)) + (setq erlang-tags-installed t))))) + + +;; Set all keys bound to `find-tag' et.al. in the global map and the +;; menu to `erlang-find-tag' et.al. in `map'. +;; +;; The function `substitute-key-definition' does not work properly +;; in all version of Emacs. + +(defun erlang-tags-define-keys (map) + "Bind tags commands to keymap MAP aware of Erlang modules." + (let ((alist erlang-tags-function-alist)) + (while alist + (let* ((old (car (car alist))) + (new (cdr (car alist))) + (keys (append (where-is-internal old global-map)))) + (while keys + (define-key map (car keys) new) + (setq keys (cdr keys)))) + (setq alist (cdr alist)))) + ;; Update the menu. + (erlang-menu-substitute erlang-menu-base-items erlang-tags-function-alist) + (erlang-menu-init)) + + +;; There exists a variable `find-tag-default-function'. It is not used +;; since `complete-tag' uses it to get current word under point. In that +;; situation we doesn't want the module to be prepended. + +(defun erlang-find-tag-default () + "Return the default tag, searches `-import' list of imported functions. +Single quotes has been stripped away." + (let ((mod-func (erlang-get-function-under-point))) + (cond ((null mod-func) + nil) + ((null (car mod-func)) + (nth 1 mod-func)) + (t + (concat (car mod-func) ":" (nth 1 mod-func)))))) + + +;; Return `t' since it is used inside `tags-loop-form'. +;;;###autoload +(defun erlang-find-tag (modtagname &optional next-p regexp-p) + "Like `find-tag'. Capable of retreiving Erlang modules. + +Tags can be given on the forms `tag', `module:', `module:tag'." + (interactive (erlang-tag-interactive "Find `module:tag' or `tag': ")) + (switch-to-buffer (erlang-find-tag-noselect modtagname next-p regexp-p)) + t) + + +;; Code mainly from `find-tag-other-window' in `etags.el'. +;;;###autoload +(defun erlang-find-tag-other-window (tagname &optional next-p regexp-p) + "Like `find-tag-other-window' but aware of Erlang modules." + (interactive (erlang-tag-interactive + "Find `module:tag' or `tag' other window: ")) + + ;; This is to deal with the case where the tag is found in the + ;; selected window's buffer; without this, point is moved in both + ;; windows. To prevent this, we save the selected window's point + ;; before doing find-tag-noselect, and restore it afterwards. + (let* ((window-point (window-point (selected-window))) + (tagbuf (erlang-find-tag-noselect tagname next-p regexp-p)) + (tagpoint (progn (set-buffer tagbuf) (point)))) + (set-window-point (prog1 + (selected-window) + (switch-to-buffer-other-window tagbuf) + ;; We have to set this new window's point; it + ;; might already have been displaying a + ;; different portion of tagbuf, in which case + ;; switch-to-buffer-other-window doesn't set + ;; the window's point from the buffer. + (set-window-point (selected-window) tagpoint)) + window-point))) + + +(defun erlang-find-tag-other-frame (tagname &optional next-p) + "Like `find-tag-other-frame' but aware of Erlang modules." + (interactive (erlang-tag-interactive + "Find `module:tag' or `tag' other frame: ")) + (let ((pop-up-frames t)) + (erlang-find-tag-other-window tagname next-p))) + + +(defun erlang-find-tag-regexp (regexp &optional next-p other-window) + "Like `find-tag-regexp' but aware of Erlang modules." + (interactive (if (fboundp 'find-tag-regexp) + (erlang-tag-interactive + "Find `module:regexp' or `regexp': ") + (error "This version of Emacs can't find tags by regexps."))) + (funcall (if other-window + 'erlang-find-tag-other-window + 'erlang-find-tag) + regexp next-p t)) + + +;; Just like C-u M-. This could be added to the menu. +(defun erlang-find-next-tag () + (interactive) + (let ((current-prefix-arg '(4))) + (if erlang-tags-installed + (call-interactively 'erlang-find-tag) + (call-interactively 'find-tag)))) + + +;; Mimics `find-tag-noselect' found in `etags.el', but uses `find-tag' to +;; be compatible with `tags.el'. +;; +;; Handles three cases: +;; * `module:' Loop over all possible filen-ames. Stop if a file-name +;; without extension and directory matches the module. +;; +;; * `module:tag' +;; Emacs 19: Replace testfunctions with functions aware of +;; Erlang modules. Tricky because the etags system wasn't +;; built for these kind of operations... +;; +;; Emacs 18: We loop over `find-tag' until we find a file +;; whose module matches the requested module. The +;; drawback is that a lot of files could be loaded into +;; Emacs. +;; +;; * `tag' Just give it to `find-tag'. + +(defun erlang-find-tag-noselect (modtagname &optional next-p regexp-p) + "Like `find-tag-noselect' but aware of Erlang modules." + (interactive (erlang-tag-interactive "Find `module:tag' or `tag': ")) + (or modtagname + (setq modtagname (symbol-value 'last-tag))) + (funcall (symbol-function 'set) 'last-tag modtagname) + ;; `tags.el' uses this variable to record how M-, would + ;; know where to restart a tags command. + (if (boundp 'tags-loop-form) + (funcall (symbol-function 'set) + 'tags-loop-form '(erlang-find-tag nil t))) + (save-window-excursion + (cond + ((string-match ":$" modtagname) + ;; Only the module name was given. Read all files whose file name + ;; match. + (let ((modname (substring modtagname 0 (match-beginning 0))) + (file nil)) + (if (not next-p) + (save-excursion + (visit-tags-table-buffer) + (setq erlang-tags-file-list + (funcall (symbol-function 'tags-table-files))))) + (while (null file) + (or erlang-tags-file-list + (save-excursion + (if (and (featurep 'etags) + (funcall + (symbol-function 'visit-tags-table-buffer) 'same) + (funcall + (symbol-function 'visit-tags-table-buffer) t)) + (setq erlang-tags-file-list + (funcall (symbol-function 'tags-table-files))) + (error "No %stags containing %s" (if next-p "more " "") + modtagname)))) + (if erlang-tags-file-list + (let ((this-module (erlang-get-module-from-file-name + (car erlang-tags-file-list)))) + (if (and (stringp this-module) + (string= modname this-module)) + (setq file (car erlang-tags-file-list))) + (setq erlang-tags-file-list (cdr erlang-tags-file-list))))) + (set-buffer (or (get-file-buffer file) + (find-file-noselect file))))) + + ((string-match ":" modtagname) + (if (boundp 'find-tag-tag-order) + ;; Method one: Add module-recognising functions to the + ;; list of order functions. However, the tags system + ;; from Emacs 18, and derives thereof (read: XEmacs) + ;; hasn't got this feature. + (progn + (erlang-tags-install-module-check) + (unwind-protect + (funcall (symbol-function 'find-tag) + modtagname next-p regexp-p) + (erlang-tags-remove-module-check))) + ;; Method two: Call the tags system until a file matching + ;; the module is found. This could result in that many + ;; files are read. (e.g. The tag "foo:file" will take a + ;; while to process.) + (let* ((modname (substring modtagname 0 (match-beginning 0))) + (tagname (substring modtagname (match-end 0) nil)) + (last-tag tagname) + file) + (while + (progn + (funcall (symbol-function 'find-tag) tagname next-p regexp-p) + (setq next-p t) + ;; Determine the module form the file name. (The + ;; alternative, to check `-module', would make this + ;; code useless for non-Erlang programs.) + (setq file (erlang-get-module-from-file-name buffer-file-name)) + (not (and (stringp file) + (string= modname file)))))))) + (t + (funcall (symbol-function 'find-tag) modtagname next-p regexp-p))) + (current-buffer))) ; Return the new buffer. + + +;; Process interactive arguments for erlang-find-tag-*. +;; +;; Negative arguments work only for `etags', not `tags'. This is not +;; a problem since negative arguments means step back into the +;; history list, a feature not implemented in `tags'. + +(defun erlang-tag-interactive (prompt) + (condition-case nil + (require 'etags) + (error + (require 'tags))) + (if current-prefix-arg + (list nil (if (< (prefix-numeric-value current-prefix-arg) 0) + '- + t)) + (let* ((default (erlang-find-tag-default)) + (prompt (if default + (format "%s(default %s) " prompt default) + prompt)) + (spec (if (featurep 'etags) + (completing-read prompt 'erlang-tags-complete-tag) + (read-string prompt)))) + (list (if (equal spec "") + (or default (error "There is no default tag")) + spec))))) + + +;; Search tag functions which are aware of Erlang modules. The tactic +;; is to store new search functions into the local variabels of the +;; TAGS buffers. The variables are restored directly after the +;; search. The situation is complicated by the fact that new TAGS +;; files can be loaded during the search. +;; +;; This code is Emacs 19 `etags' specific. + +(defun erlang-tags-install-module-check () + "Install our own tag search functions." + ;; Make sure our functions are installed in TAGS files loaded + ;; into Emacs while searching. + (setq erlang-tags-orig-format-hooks + (symbol-value 'tags-table-format-hooks)) + (funcall (symbol-function 'set) 'tags-table-format-hooks + (cons 'erlang-tags-recognize-tags-table + erlang-tags-orig-format-hooks)) + (setq erlang-tags-buffer-list '()) + ;; Install our functions in the TAGS files already resident. + (save-excursion + (let ((files (symbol-value 'tags-table-computed-list))) + (while files + (if (stringp (car files)) + (if (get-file-buffer (car files)) + (progn + (set-buffer (get-file-buffer (car files))) + (erlang-tags-install-local)))) + (setq files (cdr files)))))) + + +(defun erlang-tags-install-local () + "Install our tag search functions in current buffer." + (if erlang-tags-buffer-installed-p + () + ;; Mark this buffer as "installed" and record. + (set (make-local-variable 'erlang-tags-buffer-installed-p) t) + (setq erlang-tags-buffer-list + (cons (current-buffer) erlang-tags-buffer-list)) + + ;; Save the original values. + (set (make-local-variable 'erlang-tags-orig-tag-order) + (symbol-value 'find-tag-tag-order)) + (set (make-local-variable 'erlang-tags-orig-regexp-tag-order) + (symbol-value 'find-tag-regexp-tag-order)) + (set (make-local-variable 'erlang-tags-orig-search-function) + (symbol-value 'find-tag-search-function)) + (set (make-local-variable 'erlang-tags-orig-regexp-search-function) + (symbol-value 'find-tag-regexp-search-function)) + + ;; Install our own functions. + (set (make-local-variable 'find-tag-search-function) + 'erlang-tags-search-forward) + (set (make-local-variable 'find-tag-regexp-search-function) + 'erlang-tags-regexp-search-forward) + (set (make-local-variable 'find-tag-tag-order) + '(erlang-tag-match-module-p)) + (set (make-local-variable 'find-tag-regexp-tag-order) + '(erlang-tag-match-module-regexp-p)))) + + +(defun erlang-tags-remove-module-check () + "Remove our own tags search functions." + (funcall (symbol-function 'set) + 'tags-table-format-hooks + erlang-tags-orig-format-hooks) + ;; Remove our functions from the TAGS files. (Note that + ;; `tags-table-computed-list' need not be the same list as when + ;; the search was started.) + (save-excursion + (let ((buffers erlang-tags-buffer-list)) + (while buffers + (if (buffer-name (car buffers)) + (progn + (set-buffer (car buffers)) + (erlang-tags-remove-local))) + (setq buffers (cdr buffers)))))) + + +(defun erlang-tags-remove-local () + "Remove our tag search functions from current buffer." + (if (null erlang-tags-buffer-installed-p) + () + (funcall (symbol-function 'set) 'erlang-tags-buffer-installed-p nil) + (funcall (symbol-function 'set) + 'find-tag-tag-order erlang-tags-orig-tag-order) + (funcall (symbol-function 'set) + 'find-tag-regexp-tag-order erlang-tags-orig-regexp-tag-order) + (funcall (symbol-function 'set) + 'find-tag-search-function erlang-tags-orig-search-function) + (funcall (symbol-function 'set) + 'find-tag-regexp-search-function + erlang-tags-orig-regexp-search-function))) + + +(defun erlang-tags-recognize-tags-table () + "Install our functions in all loaded TAGS files. + +This function is added to `tags-table-format-hooks' when searching +for a tag on the form `module:tag'." + (if (null (funcall (symbol-function 'etags-recognize-tags-table))) + nil + (erlang-tags-install-local) + t)) + + +(defun erlang-tags-search-forward (tag &optional bound noerror count) + "Forward search function, aware of Erlang module prefix." + (if (string-match ":" tag) + (setq tag (substring tag (match-end 0) nil))) + ;; Avoid uninteded recursion. + (if (eq erlang-tags-orig-search-function 'erlang-tags-search-forward) + (search-forward tag bound noerror count) + (funcall erlang-tags-orig-search-function tag bound noerror count))) + + +(defun erlang-tags-regexp-search-forward (tag &optional bound noerror count) + "Forward regexp search function, aware of Erlang module prefix." + (if (string-match ":" tag) + (setq tag (substring tag (match-end 0) nil))) + (if (eq erlang-tags-orig-regexp-search-function + 'erlang-tags-regexp-search-forward) + (re-search-forward tag bound noerror count) + (funcall erlang-tags-orig-regexp-search-function + tag bound noerror count))) + + +;; t if point is at a tag line that matches TAG, containing +;; module information. Assumes that all other order functions +;; are stored in `erlang-tags-orig-[regex]-tag-order'. + +(defun erlang-tag-match-module-p (tag) + (erlang-tag-match-module-common-p tag erlang-tags-orig-tag-order)) + +(defun erlang-tag-match-module-regexp-p (tag) + (erlang-tag-match-module-common-p tag erlang-tags-orig-regexp-tag-order)) + +(defun erlang-tag-match-module-common-p (tag order) + (let ((mod nil) + (found nil)) + (if (string-match ":" tag) + (progn + (setq mod (substring tag 0 (match-beginning 0))) + (setq tag (substring tag (match-end 0) nil)))) + (while (and order (not found)) + (setq found + (and (not (memq (car order) + '(erlang-tag-match-module-p + erlang-tag-match-module-regexp-p))) + (funcall (car order) tag))) + (setq order (cdr order))) + (and found + (or (null mod) + (string= mod (erlang-get-module-from-file-name + (file-of-tag))))))) + + +;;; Tags completion, Emacs 19 `etags' specific. +;;; +;;; The basic idea is to create a second completion table `erlang-tags- +;;; completion-table' containing all normal tags plus tags on the form +;;; `module:tag'. + + +(defun erlang-complete-tag () + "Perform tags completion on the text around point. +Completes to the set of names listed in the current tags table. + +Should the Erlang tags system be installed this command knows +about Erlang modules." + (interactive) + (condition-case nil + (require 'etags) + (error nil)) + (cond ((and erlang-tags-installed + (fboundp 'complete-tag)) ; Emacs 19 + (let ((orig-tags-complete-tag (symbol-function 'tags-complete-tag))) + (fset 'tags-complete-tag + (symbol-function 'erlang-tags-complete-tag)) + (unwind-protect + (funcall (symbol-function 'complete-tag)) + (fset 'tags-complete-tag orig-tags-complete-tag)))) + ((fboundp 'complete-tag) ; Emacs 19 + (funcall (symbol-function 'complete-tag))) + ((fboundp 'tag-complete-symbol) ; XEmacs + (funcall (symbol-function 'tag-complete-symbol))) + (t + (error "This version of Emacs can't complete tags.")))) + + +;; Based on `tags-complete-tag', but this one uses +;; `erlang-tag-completion-table' instead of `tag-completion-table'. +;; +;; This is the entry-point called by system function `completing-read'. +(defun erlang-tags-complete-tag (string predicate what) + (save-excursion + ;; If we need to ask for the tag table, allow that. + (let ((enable-recursive-minibuffers t)) + (visit-tags-table-buffer)) + (if (eq what t) + (all-completions string (erlang-tags-completion-table) predicate) + (try-completion string (erlang-tags-completion-table) predicate)))) + + +;; `tags-completion-table' calls itself recursively, make it +;; call our own wedge instead. Note that the recursive call +;; is very rare; it only occurs when a tags-file contains +;; `include'-statements. +(defun erlang-tags-completion-table () + "Build completion table. Tags on the form `tag' or `module:tag'." + (setq erlang-tags-orig-completion-table + (symbol-function 'tags-completion-table)) + (fset 'tags-completion-table + (symbol-function 'erlang-tags-completion-table-1)) + (unwind-protect + (erlang-tags-completion-table-1) + (fset 'tags-completion-table + erlang-tags-orig-completion-table))) + + +(defun erlang-tags-completion-table-1 () + (make-local-variable 'erlang-tags-completion-table) + (or erlang-tags-completion-table + (let ((tags-completion-table nil) + (tags-completion-table-function + 'erlang-etags-tags-completion-table)) + (funcall erlang-tags-orig-completion-table) + (setq erlang-tags-completion-table tags-completion-table)))) + + +;; Based on `etags-tags-completion-table'. The difference is that we +;; adds three symbols to the vector, the tag, module: and module:tag. +;; The module is extracted from the file name of a tag. (This one +;; only works if we are looking at an `etags' file. However, this is +;; the only format supported by Emacs, so far.) +(defun erlang-etags-tags-completion-table () + (let ((table (make-vector 511 0)) + (file nil)) + (save-excursion + (goto-char (point-min)) + ;; This monster regexp matches an etags tag line. + ;; \1 is the string to match; + ;; \2 is not interesting; + ;; \3 is the guessed tag name; XXX guess should be better eg DEFUN + ;; \4 is not interesting; + ;; \5 is the explicitly-specified tag name. + ;; \6 is the line to start searching at; + ;; \7 is the char to start searching at. + (while (progn + (while (and + (eq (following-char) ?\f) + (looking-at "\f\n\\([^,\n]*\\),.*\n")) + (setq file (buffer-substring + (match-beginning 1) (match-end 1))) + (goto-char (match-end 0))) + (re-search-forward + "\ +^\\(\\([^\177]+[^-a-zA-Z0-9_$\177]+\\)?\\([-a-zA-Z0-9_$?:]+\\)\ +\[^-a-zA-Z0-9_$?:\177]*\\)\177\\(\\([^\n\001]+\\)\001\\)?\ +\\([0-9]+\\)?,\\([0-9]+\\)?\n" + nil t)) + (let ((tag (if (match-beginning 5) + ;; There is an explicit tag name. + (buffer-substring (match-beginning 5) (match-end 5)) + ;; No explicit tag name. Best guess. + (buffer-substring (match-beginning 3) (match-end 3)))) + (module (and file + (erlang-get-module-from-file-name file)))) + (intern tag table) + (if (stringp module) + (progn + (intern (concat module ":" tag) table) + ;; Only the first one will be stored in the table. + (intern (concat module ":") table)))))) + table)) + +;;; +;;; Prepare for other methods to run an Erlang slave process. +;;; + +(defvar erlang-shell-function 'inferior-erlang + "Command to execute start a new Erlang shell. + +Change this variable to use your favorite +Erlang compilation package.") + +(defvar erlang-shell-display-function 'inferior-erlang-run-or-select + "Command to execute to display Erlang shell. + +Change this variable to use your favorite +Erlang compilation package.") + +(defvar erlang-compile-function 'inferior-erlang-compile + "Command to execute to compile current buffer. + +Change this variable to use your favorite +Erlang compilation package.") + +(defvar erlang-compile-display-function 'inferior-erlang-run-or-select + "Command to execute to view last compilation. + +Change this variable to use your favorite +Erlang compilation package.") + +(defvar erlang-next-error-function 'inferior-erlang-next-error + "Command to execute to go to the next error. + +Change this variable to use your favorite +Erlang compilation package.") + + +;;;###autoload +(defun erlang-shell () + "Start a new Erlang shell. + +The variable `erlang-shell-function' decides which method to use, +default is to start a new Erlang host. It is possible that, in the +future, a new shell on an already running host will be started." + (interactive) + (call-interactively erlang-shell-function)) + + +;;;###autoload (autoload 'run-erlang "erlang" "Start a new Erlang shell." t) + +;; It is customary for Emacs packages to supply a function on this +;; form, even though it violates the `erlang-*' name convention. +(fset 'run-erlang 'erlang-shell) + + +(defun erlang-shell-display () + "Display an Erlang shell, or start a new." + (interactive) + (call-interactively erlang-shell-display-function)) + + +;;;###autoload +(defun erlang-compile () + "Compile Erlang module in current buffer." + (interactive) + (call-interactively erlang-compile-function)) + + +(defun erlang-compile-display () + "Display compilation output." + (interactive) + (call-interactively erlang-compile-display-function)) + + +(defun erlang-next-error () + "Display next error message from the latest compilation." + (interactive) + (call-interactively erlang-next-error-function)) + + + +;;; +;;; Erlang Shell Mode -- Major mode used for Erlang shells. +;;; + +;; This mode is designed to be implementation independent, +;; e.g. it does not assume that we are running an inferior +;; Erlang, there exists a lot of other possibilities. + + +(defvar erlang-shell-buffer-name "*erlang*" + "*The name of the Erlang link shell buffer.") + + +(defvar erlang-shell-mode-map nil + "*Keymap used by Erlang shells.") + + +(defvar erlang-shell-mode-hook nil + "*User functions to run when an Erlang shell is started. + +This hook is used to change the behaviour of Erlang mode. It is +normally used by the user to personalise the programming environment. +When used in a site init file, it could be used to customise Erlang +mode for all users on the system. + +The functioned added to this hook is runed every time a new Erlang +shell is started. + +See also `erlang-load-hook', a hook which is runed once, when Erlang +mode is loaded, and `erlang-mode-hook' which is runed every time a new +Erlang source file is loaded into Emacs.") + + +(defvar erlang-input-ring-file-name "~/.erlang_history" + "*When non-nil, file name used to store erlang shell history information.") + + +(defun erlang-shell-mode () + "Major mode for interacting with an Erlang shell. + +We assume that we already are in comint-mode. + +The following special commands are available: +\\{erlang-shell-mode-map}" + (interactive) + (setq major-mode 'erlang-shell-mode) + (setq mode-name "Erlang Shell") + (erlang-mode-variables) + (if erlang-shell-mode-map + nil + (setq erlang-shell-mode-map (copy-keymap comint-mode-map)) + (erlang-shell-mode-commands erlang-shell-mode-map)) + (use-local-map erlang-shell-mode-map) + (set (make-local-variable 'compilation-parsing-end) 1) + (set (make-local-variable 'compilation-error-list) nil) + (set (make-local-variable 'compilation-old-error-list) nil) + ;; Needed when compiling directly from the Erlang shell. + (setq compilation-last-buffer (current-buffer)) + (erlang-add-compilation-alist erlang-error-regexp-alist) + (setq comint-prompt-regexp "^[^>=]*> *") + (setq comint-eol-on-send t) + (setq comint-input-ignoredups t) + (setq comint-scroll-show-maximum-output t) + (setq comint-scroll-to-bottom-on-output t) + ;; In Emacs 19.30, `add-hook' has got a `local' flag, use it. If + ;; the call fails, just call the normal `add-hook'. + (condition-case nil + (progn + (funcall (symbol-function 'add-hook) 'comint-output-filter-functions + 'inferior-erlang-strip-delete nil t) + (funcall (symbol-function 'add-hook) 'comint-output-filter-functions + 'inferior-erlang-strip-ctrl-m nil t)) + (error + (add-hook 'comint-output-filter-functions 'inferior-erlang-strip-delete) + (add-hook 'comint-output-filter-functions 'inferior-erlang-strip-ctrl-m))) + ;; Some older versions of comint doesn't have an input ring. + (if (fboundp 'comint-read-input-ring) + (progn + (setq comint-input-ring-file-name erlang-input-ring-file-name) + (comint-read-input-ring t) + (make-local-variable 'kill-buffer-hook) + (add-hook 'kill-buffer-hook 'comint-write-input-ring))) + (run-hooks 'erlang-shell-mode-hook)) + + +(defun erlang-shell-mode-commands (map) + (define-key map "\M-\t" 'erlang-complete-tag) + (define-key map "\C-a" 'comint-bol) ; Normally the other way around. + (define-key map "\C-c\C-a" 'beginning-of-line) + (define-key map "\C-d" nil) ; Was `comint-delchar-or-maybe-eof' + (define-key map "\C-x`" 'erlang-next-error)) + +;;; +;;; Inferior Erlang -- Run an Erlang shell as a subprocess. +;;; + +(defvar inferior-erlang-display-buffer-any-frame nil + "*When nil, `inferior-erlang-display-buffer' use only selected frame. +When t, all frames are searched. When 'raise, the frame is raised.") + +(defvar inferior-erlang-shell-type 'newshell + "The type of Erlang shell to use. + +When this variable is set to the atom `oldshell', the old shell is used. +When set to `newshell' the new shell is used. Should the variable be +nil, the default shell is used. + +This variable influence the setting of other variables.") + +(defvar inferior-erlang-machine "erl" + "*The name of the Erlang shell.") + +(defvar inferior-erlang-machine-options '() + "*The options used when activating the Erlang shell. + +This must be a list of strings.") + +(defvar inferior-erlang-process-name "inferior-erlang" + "*The name of the inferior Erlang process.") + +(defvar inferior-erlang-buffer-name erlang-shell-buffer-name + "*The name of the inferior erlang buffer.") + +(defvar inferior-erlang-prompt-timeout 60 + "*Number of seconds before `inferior-erlang-wait-prompt' timeouts. + +The time specified is waited after every output made by the inferior +Erlang shell. When this variable is t, we assume that we always have +a prompt. When nil, we will wait forever, or until C-g.") + +(defvar inferior-erlang-process nil + "Process of last invoked inferior Erlang, or nil.") + +(defvar inferior-erlang-buffer nil + "Buffer of last invoked inferior Erlang, or nil.") + +;;;###autoload +(defun inferior-erlang () + "Run an inferior Erlang. + +This is just like running Erlang in a normal shell, except that +an Emacs buffer is used for input and output. + +The command line history can be accessed with M-p and M-n. +The history is saved between sessions. + +Entry to this mode calls the functions in the variables +`comint-mode-hook' and `erlang-shell-mode-hook' with no arguments. + +The following commands imitate the usual Unix interrupt and +editing control characters: +\\{erlang-shell-mode-map}" + (interactive) + (require 'comint) + (let ((opts inferior-erlang-machine-options)) + (cond ((eq inferior-erlang-shell-type 'oldshell) + (setq opts (cons "-oldshell" opts))) + ((eq inferior-erlang-shell-type 'newshell) + (setq opts (append '("-newshell" "-env" "TERM" "vt100") opts)))) + (setq inferior-erlang-buffer + (apply 'make-comint + inferior-erlang-process-name inferior-erlang-machine + nil opts))) + (setq inferior-erlang-process + (get-buffer-process inferior-erlang-buffer)) + (process-kill-without-query inferior-erlang-process) + (switch-to-buffer inferior-erlang-buffer) + (if (and (not (eq system-type 'windows-nt)) + (eq inferior-erlang-shell-type 'newshell)) + (setq comint-process-echoes t)) + ;; `rename-buffer' takes only one argument in Emacs 18. + (condition-case nil + (rename-buffer inferior-erlang-buffer-name t) + (error (rename-buffer inferior-erlang-buffer-name))) + (erlang-shell-mode)) + + +(defun inferior-erlang-run-or-select () + "Switch to an inferior Erlang buffer, possibly starting new process." + (interactive) + (if (null (inferior-erlang-running-p)) + (inferior-erlang) + (inferior-erlang-display-buffer t))) + + +(defun inferior-erlang-display-buffer (&optional select) + "Make the inferior Erlang process visible. +The window is returned. + +Should `inferior-erlang-display-buffer-any-frame' be nil the buffer is +displayed in the current frame. Should it be non-nil, and the buffer +already is visible in any other frame, no new window will be created. +Should it be the atom 'raise, the frame containing the window will +be raised. + +Should the optional argument SELECT be non-nil, the window is +selected. Should the window be in another frame, that frame is raised. + +Note, should the mouse pointer be places outside the raised frame, that +frame will become deselected before the next command." + (interactive) + (or (inferior-erlang-running-p) + (error "No inferior Erlang process is running.")) + (let ((win (inferior-erlang-window + inferior-erlang-display-buffer-any-frame)) + (frames-p (fboundp 'selected-frame))) + (if (null win) + (let ((old-win (selected-window))) + (save-excursion + (switch-to-buffer-other-window inferior-erlang-buffer) + (setq win (selected-window))) + (select-window old-win)) + (if (and window-system + frames-p + (or select + (eq inferior-erlang-display-buffer-any-frame 'raise)) + (not (eq (selected-frame) (window-frame win)))) + (raise-frame (window-frame win)))) + (if select + (select-window win)) + (sit-for 0) + win)) + + +(defun inferior-erlang-running-p () + "Non-nil when an inferior Erlang is running." + (and inferior-erlang-process + (memq (process-status inferior-erlang-process) '(run open)) + inferior-erlang-buffer + (buffer-name inferior-erlang-buffer))) + + +(defun inferior-erlang-window (&optional all-frames) + "Return the window containing the inferior Erlang, or nil." + (and (inferior-erlang-running-p) + (if (and all-frames (>= erlang-emacs-major-version 19)) + (get-buffer-window inferior-erlang-buffer t) + (get-buffer-window inferior-erlang-buffer)))) + + +(defun inferior-erlang-wait-prompt () + "Wait until the inferior Erlang shell prompt appear." + (if (eq inferior-erlang-prompt-timeout t) + () + (or (inferior-erlang-running-p) + (error "No inferior Erlang shell is running.")) + (save-excursion + (set-buffer inferior-erlang-buffer) + (let ((msg nil)) + (while (save-excursion + (goto-char (process-mark inferior-erlang-process)) + (forward-line 0) + (not (looking-at comint-prompt-regexp))) + (if msg + () + (setq msg t) + (message "Waiting for Erlang shell prompt (press C-g to abort).")) + (or (accept-process-output inferior-erlang-process + inferior-erlang-prompt-timeout) + (error "No Erlang shell prompt before timeout."))) + (if msg (message "")))))) + + +(defun inferior-erlang-send-command (cmd &optional hist) + "Send command CMD to the inferior Erlang. + +The contents of the current command line (if any) will +be placed at the next prompt. + +If optional second argument is non-nil the command is inserted into +the history list. + +Return the position after the newly inserted command." + (or (inferior-erlang-running-p) + (error "No inferior Erlang process is running.")) + (let ((old-buffer (current-buffer)) + (insert-point (marker-position + (process-mark inferior-erlang-process))) + (insert-length (if comint-process-echoes + 0 + (1+ (length cmd))))) + (set-buffer inferior-erlang-buffer) + (goto-char insert-point) + (insert cmd) + ;; Strange things happend if `comint-eol-on-send' is declared + ;; in the `let' expression above, but setq:d here. The + ;; `set-buffer' statement obviously makes the buffer local + ;; instance of `comint-eol-on-send' shadow this one. + ;; I'm considering this a bug in Elisp. + (let ((comint-eol-on-send nil) + (comint-input-filter (if hist comint-input-filter 'ignore))) + (comint-send-input)) + ;; Adjust all windows whose points are incorrect. + (if (null comint-process-echoes) + (walk-windows + (function + (lambda (window) + (if (and (eq (window-buffer window) inferior-erlang-buffer) + (eq (window-point window) insert-point)) + (set-window-point window + (+ insert-point insert-length))))) + nil t)) + (set-buffer old-buffer) + (+ insert-point insert-length))) + + +(defun inferior-erlang-strip-delete (&optional s) + "Remove `^H' (delete) and the characters it was supposed to remove." + (interactive) + (if (and (boundp 'comint-last-input-end) + (boundp 'comint-last-output-start)) + (save-excursion + (goto-char + (if (interactive-p) + (symbol-value 'comint-last-input-end) + (symbol-value 'comint-last-output-start))) + (while (progn (skip-chars-forward "^\C-h") + (not (eq (point) (point-max)))) + (delete-char 1) + (or (bolp) + (backward-delete-char 1)))))) + + +;; Basically `comint-strip-ctrl-m', with a few extra checks. +(defun inferior-erlang-strip-ctrl-m (&optional string) + "Strip trailing `^M' characters from the current output group." + (interactive) + (if (and (boundp 'comint-last-input-end) + (boundp 'comint-last-output-start)) + (let ((pmark (process-mark (get-buffer-process (current-buffer))))) + (save-excursion + (goto-char + (if (interactive-p) + (symbol-value 'comint-last-input-end) + (symbol-value 'comint-last-output-start))) + (while (re-search-forward "\r+$" pmark t) + (replace-match "" t t)))))) + + +(defun inferior-erlang-compile () + "Compile the file in the current buffer. + +Should Erlang return `{error, nofile}' it could not load the object +module after completing the compilation. This is due to a bug in the +compile command `c' when using the option `outdir'. + +There exists two workarounds for this bug: + + 1) Place the directory in the Erlang load path. + + 2) Set the Emacs variable `erlang-compile-use-outdir' to nil. + To do so, place the following line in your `~/.emacs'-file: + (setq erlang-compile-use-outdir nil)" + (interactive) + (save-some-buffers) + (or (inferior-erlang-running-p) + (save-excursion + (inferior-erlang))) + (or (inferior-erlang-running-p) + (error "Error starting inferior Erlang shell.")) + (let ((dir (file-name-directory (buffer-file-name))) + ;;; (file (file-name-nondirectory (buffer-file-name))) + (noext (substring (buffer-file-name) 0 -4)) + ;; Hopefully, noone else will ever use these... + (tmpvar "Tmp7236") + (tmpvar2 "Tmp8742") + end) + (inferior-erlang-display-buffer) + (inferior-erlang-wait-prompt) + (setq end (inferior-erlang-send-command + (if erlang-compile-use-outdir + (format "c(\"%s\", [{outdir, \"%s\"}])." noext dir) + (format + (concat + "f(%s), {ok, %s} = file:get_cwd(), " + "file:set_cwd(\"%s\"), " + "%s = c(\"%s\"), file:set_cwd(%s), f(%s), %s.") + tmpvar2 tmpvar + dir + tmpvar2 noext tmpvar tmpvar tmpvar2)) + nil)) + (save-excursion + (set-buffer inferior-erlang-buffer) + (setq compilation-error-list nil) + (setq compilation-parsing-end end)) + (setq compilation-last-buffer inferior-erlang-buffer))) + + +;; `next-error' only accepts buffers with major mode `compilation-mode' +;; or with the minor mode `compilation-minor-mode' activated. +;; (To activate the minor mode is out of the question, since it will +;; ruin the inferior Erlang keymap.) +(defun inferior-erlang-next-error (&optional argp) + "Just like `next-error'. +Capable of finding error messages in an inferior Erlang buffer." + (interactive "P") + (let ((done nil) + (buf (and (boundp 'compilation-last-buffer) + compilation-last-buffer))) + (if (and (bufferp buf) + (save-excursion + (set-buffer buf) + (and (eq major-mode 'erlang-shell-mode) + (setq major-mode 'compilation-mode)))) + (unwind-protect + (progn + (setq done t) + (next-error argp)) + (save-excursion + (set-buffer buf) + (setq major-mode 'erlang-shell-mode)))) + (or done + (next-error argp)))) + + +(defun inferior-erlang-change-directory (&optional dir) + "Make the inferior erlang change directory. +The default is to go to the directory of the current buffer." + (interactive) + (or dir (setq dir (file-name-directory (buffer-file-name)))) + (or (inferior-erlang-running-p) + (error "No inferior Erlang is running.")) + (inferior-erlang-display-buffer) + (inferior-erlang-wait-prompt) + (inferior-erlang-send-command (format "cd('%s')." dir) nil)) + +;; Aliases for backward compatibility with older versions of Erlang Mode. +;; +;; Unfortuantely, older versions of Emacs doesn't have `defalias' and +;; `make-obsolete' so we have to define our own `obsolete' function. + +(defun erlang-obsolete (sym newdef) + "Make the obsolete function SYM refer to the defined function NEWDEF. + +Simplified version of a combination `defalias' and `make-obsolete', +it assumes that NEWDEF is loaded." + (fset sym (symbol-function newdef)) + (if (fboundp 'make-obsolete) + (make-obsolete sym newdef))) + + +(erlang-obsolete 'calculate-erlang-indent 'erlang-calculate-indent) +(erlang-obsolete 'calculate-erlang-stack-indent + 'erlang-calculate-stack-indent) +(erlang-obsolete 'at-erlang-keyword 'erlang-at-keyword) +(erlang-obsolete 'at-erlang-operator 'erlang-at-operator) +(erlang-obsolete 'beginning-of-erlang-clause 'erlang-beginning-of-clause) +(erlang-obsolete 'end-of-erlang-clause 'erlang-end-of-clause) +(erlang-obsolete 'mark-erlang-clause 'erlang-mark-clause) +(erlang-obsolete 'beginning-of-erlang-function 'erlang-beginning-of-function) +(erlang-obsolete 'end-of-erlang-function 'erlang-end-of-function) +(erlang-obsolete 'mark-erlang-function 'erlang-mark-function) +(erlang-obsolete 'pass-over-erlang-clause 'erlang-pass-over-function) +(erlang-obsolete 'name-of-erlang-function 'erlang-name-of-function) + + +;; The end... + +(provide 'erlang) + +(run-hooks 'erlang-load-hook) + +;;; erlang.el ends here diff --git a/lib/erl/tools/utilities/appgen b/lib/erl/tools/utilities/appgen new file mode 100755 index 00000000..b619222b --- /dev/null +++ b/lib/erl/tools/utilities/appgen @@ -0,0 +1,69 @@ +#!/bin/sh + + +if [ $# -ne 2 ];then + echo "" + echo "usage: $0 " + echo "" + echo "appname is the title of the application to be generated" + echo "prefix is the prefix that will be appended to all files in" + echo "the application due to erlangs lack of a package structure. The prefix" + echo "is typicaly the first letter of each word in the name of the application" + echo "" + echo "example: $0 chat_server cs" + echo "" + exit 1 +fi + +APP_NAME=$1 +APP_NAME_UPPER_CASE=$(echo $APP_NAME | tr a-z A-Z) +PREFIX=$2 + +cd ../.appgen +echo `pwd` + +cp -r blank_app $APP_NAME +cp -r blank_app_rel "$APP_NAME"_rel + +cd "$APP_NAME"_rel +ls blank_app* | ../rename.sh blank_app $APP_NAME +cd .. + +# The base directory of the release +./substitute.sh %%APP_NAME%% $APP_NAME "$APP_NAME"_rel/"$APP_NAME"_rel.rel.src + + +cd $APP_NAME/src +ls ba* | ../../rename.sh ba $PREFIX +ls blank_app* | ../../rename.sh blank_app $APP_NAME +cd - + +# The base directory of the application +./substitute.sh %%APP_NAME_UPPER_CASE%% $APP_NAME_UPPER_CASE $APP_NAME/Makefile +./substitute.sh %%APP_NAME_UPPER_CASE%% $APP_NAME_UPPER_CASE $APP_NAME/vsn.mk + +# The src directory of the application +./substitute.sh %%APP_NAME%% $APP_NAME $APP_NAME/src/Makefile +./substitute.sh %%APP_NAME_UPPER_CASE%% $APP_NAME_UPPER_CASE $APP_NAME/src/Makefile +./substitute.sh %%PFX%% $PREFIX $APP_NAME/src/Makefile + +./substitute.sh %%APP_NAME%% $APP_NAME $APP_NAME/src/"$APP_NAME".erl +./substitute.sh %%PFX%% $PREFIX $APP_NAME/src/"$APP_NAME".erl +./substitute.sh %%PFX%% $PREFIX $APP_NAME/src/"$PREFIX"_sup.erl +./substitute.sh %%APP_NAME%% $APP_NAME $APP_NAME/src/"$PREFIX"_sup.erl +./substitute.sh %%PFX%% $PREFIX $APP_NAME/src/"$PREFIX"_server.erl +./substitute.sh %%APP_NAME%% $APP_NAME $APP_NAME/src/"$PREFIX"_server.erl + +# include directory +mv $APP_NAME/include/blank_app.hrl $APP_NAME/include/"$APP_NAME".hrl + +find $APP_NAME -name ".svn" | xargs rm -r +mv $APP_NAME ../../lib +mv "$APP_NAME"_rel ../../release + +echo "" +echo "$APP_NAME has been generated and placed under lib/$APP_NAME" +echo $APP_NAME"_rel has been generated and placed under release/$APP_NAME""_rel" +echo "" + +cd ../utilities diff --git a/lib/erl/tools/utilities/clean_release b/lib/erl/tools/utilities/clean_release new file mode 100755 index 00000000..92026907 --- /dev/null +++ b/lib/erl/tools/utilities/clean_release @@ -0,0 +1,51 @@ +#!/bin/bash + +if [ $# -eq 1 ]; then + RELEASE_NAME=$1 +else + RELEASE_NAME=$(basename $(dirname $(dirname $(dirname $(which $0))))) +fi + +LOCAL=$(dirname $(which $0)) + +echo $LOCAL +echo $RELEASE_NAME +cd $LOCAL + +echo " +-module(clean_release). +-export([clean_release/1]). + +clean_release([ReleaseName]) -> + RelFile = atom_to_list(ReleaseName) ++ \".rel\", + case file:consult(RelFile) of + {ok, [{release, {RelName, RelVsn}, ErtsSpec, ReleaseSpecs}]} -> do_rest(RelFile, ReleaseSpecs); + {error, Reason} -> io:format(\"ERROR - Could not find file ~s~n\", [RelFile]), exit(Reason) + end, + os:cmd(\"cd ../;rm -rf \" ++ string:strip(os:cmd(\"basename `pwd`\"))). + +do_rest(RelFile, ReleaseSpecs) -> + io:format(\"Finding Orphans in ~p among current release specs ~p~n\", [RelFile, ReleaseSpecs]), + {ok, FileNameList} = file:list_dir(\"../\"), + Dirs = [FileName || FileName <- FileNameList, filelib:is_dir(\"../\" ++ FileName)] -- + [string:strip(os:cmd(\"basename `pwd`\"), right, $\n)], + BigListOfReleaseSpecs = lists:foldl(fun(Dir, Acc) -> + OtherRelFile = \"../\" ++ Dir ++ \"/\" ++ RelFile, + io:format(\"Checking external release file ~p~n\", [OtherRelFile]), + case file:consult(OtherRelFile) of + {ok, [{release, {RelName, RelVsn}, ErtsSpec, ReleaseSpecs_}]} -> + Acc ++ ReleaseSpecs_; + _ -> + Acc + end end, [], Dirs), + Orphans = ReleaseSpecs -- BigListOfReleaseSpecs, + io:format(\"Removing orphan release specs ~p from ../../lib ~n\", [Orphans]), + lists:foreach(fun(Orphan) -> + os:cmd(\"rm -rf ../../lib/\" ++ atom_to_list(element(1, Orphan)) ++ \"-\" ++ element(2, Orphan)) + end, Orphans). +" > clean_release.erl + +erlc clean_release.erl + +CMD="erl -s clean_release clean_release $RELEASE_NAME -s erlang halt -noshell" +$CMD diff --git a/lib/erl/tools/utilities/edoc b/lib/erl/tools/utilities/edoc new file mode 100755 index 00000000..632f2616 --- /dev/null +++ b/lib/erl/tools/utilities/edoc @@ -0,0 +1,16 @@ +#!/bin/sh +if [ "$#" -ne "1" ] +then + echo $USAGE + exit 1 +fi + +CURRENT_DIR=`pwd` +echo $CURRENT_DIR + +# Establish the otp base directory. +MY_CMD=`which $0` +MY_CMD_DIR=`dirname $MY_CMD` +OTP_BASE_DIR=$MY_CMD_DIR/../.. + +erl -noshell -pz $OTP_BASE_DIR/lib/fslib/ebin -s fs_lib s_apply edoc application "$1". "\"../../$1"\". []." " -s init stop | egrep "(EXIT|terminating)" diff --git a/tutorial/erl/calculatorHandler.erl b/tutorial/erl/calculatorHandler.erl deleted file mode 100644 index 5d420192..00000000 --- a/tutorial/erl/calculatorHandler.erl +++ /dev/null @@ -1,68 +0,0 @@ --module(calculatorHandler). - --include("thrift/thrift.hrl"). --include("thrift/transport/tSocket.hrl"). --include("thrift/protocol/tBinaryProtocol.hrl"). --include("thrift/server/tServer.hrl"). --include("thrift/transport/tServerSocket.hrl"). - --include("gen-erl/calculator.hrl"). -%-include("gen-erl/shared_types.hrl"). - -%-include("gen-erl/tutorial_types.hrl"). % TODO(cpiro): o rly? - --export([start/0, ping/0, add/2, calculate/2, getStruct/1, zip/0]). - -%%% def initialize() -%%% @log = {} -%%% end - -% TODO: voids take only ok as return? - -ping() -> - io:format("ping()~n",[]), - {ok, nil}. - -add(N1, N2) -> - io:format("add(~p,~p)~n",[N1,N2]), - {ok, N1+N2}. - -calculate(Logid, Work) -> - { Op, Num1, Num2 } = { Work#work.op, Work#work.num1, Work#work.num2 }, - io:format("calculate(~p, {~p,~p,~p})~n", [Logid, Op, Num1, Num2]), - case Op of - ?ADD -> {ok, Num1 + Num2}; - ?SUBTRACT -> {ok, Num1 - Num2}; - ?MULTIPLY -> {ok, Num1 * Num2}; - ?DIVIDE -> - if Num2 == 0 -> {error, #invalidOperation{what=Op, why="Cannot divide by 0"}}; - true -> {ok, Num1 / Num2} - end; - true -> - {error, #invalidOperation{what=Op, why="Invalid operation"}} - end. - -getStruct(Key) -> - io:format("getStruct(~p)~n", [Key]), - {ok, get(Key)}. - -zip() -> - io:format("zip~n"). - -start() -> - Transport = tServerSocket:new(9090), - Server = tServer:new(calculator, ?MODULE, Transport), - io:format("Starting the server...~n", []), - ?M0(Server, serve), - io:format("done.~n", []), % won't ever reach, rookie beotch - ok. - -%%% handler = CalculatorHandler.new() -%%% processor = Calculator::Processor.new(handler) -%%% transport = TServerSocket.new(9090) -%%% transportFactory = TBufferedTransportFactory.new() -%%% server = TSimpleServer.new(processor, transport, transportFactory) -%%% -%%% puts "Starting the server..." -%%% server.serve() -%%% puts "done." diff --git a/tutorial/erl/server.erl b/tutorial/erl/server.erl new file mode 100644 index 00000000..c924589b --- /dev/null +++ b/tutorial/erl/server.erl @@ -0,0 +1,66 @@ +-module(server). + +-include("thrift.hrl"). +-include("transport/tSocket.hrl"). +-include("protocol/tBinaryProtocol.hrl"). + +-include("server/tErlServer.hrl"). +-include("transport/tErlAcceptor.hrl"). + +-include("calculator.hrl"). + +-export([start/0, stop/1, ping/0, add/2, calculate/2, getStruct/1, zip/0]). + +ping() -> + io:format("ping()~n",[]), + {ok, nil}. + +add(N1, N2) -> + io:format("add(~p,~p)~n",[N1,N2]), + {ok, N1+N2}. + +calculate(Logid, Work) -> + { Op, Num1, Num2 } = { Work#work.op, Work#work.num1, Work#work.num2 }, + io:format("calculate(~p, {~p,~p,~p})~n", [Logid, Op, Num1, Num2]), + case Op of + ?ADD -> {ok, Num1 + Num2}; + ?SUBTRACT -> {ok, Num1 - Num2}; + ?MULTIPLY -> {ok, Num1 * Num2}; + ?DIVIDE -> + if Num2 == 0 -> {error, #invalidOperation{what=Op, why="Cannot divide by 0"}}; + true -> {ok, Num1 / Num2} + end; + true -> + {error, #invalidOperation{what=Op, why="Invalid operation"}} + end. + +getStruct(Key) -> + io:format("getStruct(~p)~n", [Key]), + {ok, get(Key)}. + +zip() -> + io:format("zip~n"). + +%% + +start() -> + Handler = ?MODULE, % cpiro: or generated handler? + Processor = calculator, + Port = 9090, + + TF = tBufferedTransportFactory:new(), + PF = tBinaryProtocolFactory:new(), + + ServerTransport = tErlAcceptor, + ServerFlavor = tErlServer, + + Server = oop:start_new(ServerFlavor, [Port, Handler, Processor, ServerTransport, TF, PF]), + + ?R0(Server, effectful_serve), + + Server. + +stop(Server) -> + ?C0(Server, stop), + ok. +