/pliant/language/basic/plugin.pli
 
 1  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 2  # 
 3  # This program is free software; you can redistribute it and/or 
 4  # modify it under the terms of the GNU General Public License version 2 
 5  # as published by the Free Software Foundation. 
 6  # 
 7  # This program is distributed in the hope that it will be useful, 
 8  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 9  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 10  # GNU General Public License for more details. 
 11  # 
 12  # You should have received a copy of the GNU General Public License 
 13  # version 2 along with this program; if not, write to the Free Software 
 14  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 15   
 16  module "/pliant/language/debug/compile_log.pli" 
 17  module "/pliant/install/ring2.pli" 
 18   
 19  constant advanced true 
 20  constant trace true 
 21   
 22   
 23  function file_database_pick filename path -> value 
 24    arg Str filename path value 
 25    value := "" 
 26    var Int := file_open pliant_root_path+".."+filename 1 
 27    if h=(-1) 
 28      return 
 29    var Str char := " " 
 30    var Str line := "" 
 31    while (file_read char:characters 1)=1 
 32      if char="[lf]" 
 33        var Int := line search "path=[dq]" -1 
 34        if i<>(-1) 
 35          := i+6 
 36          var Int := i+((line line:len) search "[dq]" -1) 
 37          if j>=and (line j-i)=path 
 38            var Int := line search ">" -1 
 39            if k<>(-1) 
 40              := k+1 
 41              var Int := k+((line line:len) search "<" -1) 
 42              if l>=k 
 43                file_close h 
 44                value := line l-k 
 45        line := "" 
 46      else 
 47        line := line+char 
 48    file_close h 
 49   
 50  gvar Dictionary modules 
 51  gvar Str computer_name 
 52  gvar Str computer_domain 
 53  gvar Str computer_fullname 
 54   
 55  computer_name := file_database_pick "/pliant_security/this_computer.pdb" "/env/pliant/identity/name" 
 56  computer_domain := file_database_pick "/pliant_security/this_computer.pdb" "/env/pliant/identity/domain" 
 57  if computer_domain<>"" 
 58    computer_fullname := computer_name+"."+computer_domain 
 59  else 
 60    computer_fullname := computer_name 
 61     
 62   
 63  meta custom e 
 64    if e:size<>or not e:0:is_pure_ident 
 65      return 
 66    var Str name := e:module:name 
 67    if (name 0 8)<>"/custom/" 
 68      return 
 69    name := name name:len 
 70    var Int := name search "/" -1 
 71    if i=(-1) 
 72      return 
 73    name := name name:len 
 74    name := name 0 (name search " (" name:len) 
 75    var Pointer:Arrow :> modules first name 
 76    if c=null 
 77      return 
 78    var Pointer:Dictionary :> map Dictionary 
 79    if advanced 
 80      var Link:PackedExpression :> 1 
 81      insert e:0:ident true addressof:p 
 82    else 
 83      d insert e:0:ident true (addressof e:1) 
 84    set_void_result 
 85   
 86   
 87  function the_plugin name id -> e 
 88    arg Str name id ; arg Link:Expression e 
 89    var Pointer:Arrow :> modules first name 
 90    if c=null 
 91      modules insert name true (addressof new:Dictionary) 
 92      :> modules first name 
 93      pliant_load_module "/custom/universal"+name the_module:"/pliant/language/basic/safe.pli" 0 (null map Module) 
 94      if computer_domain<>"" 
 95        pliant_load_module "/custom/"+computer_domain+name the_module:"/pliant/language/basic/safe.pli" 0 (null map Module) 
 96      if computer_fullname<>"" 
 97        pliant_load_module "/custom/"+computer_fullname+name the_module:"/pliant/language/basic/safe.pli" 0 (null map Module) 
 98    var Pointer:Dictionary :> map Dictionary 
 99    :> first id 
 100    if c<>null 
 101      if advanced 
 102        :> map PackedExpression 
 103      else 
 104        e :> c map Expression 
 105    else 
 106      :> null map Expression 
 107   
 108  method e switch_module m 
 109    arg_rw Expression e ; arg Module m 
 110    module :> m 
 111    for (var Int i) e:size-1 
 112      e:switch_module m 
 113   
 114  meta plugin e 
 115    if e:size<or e:size>or not e:0:is_pure_ident 
 116      return 
 117    var Str name := e:module:name 
 118    name := name 0 (name search " (" name:len) 
 119    var Link:Expression :> the_plugin name e:0:ident 
 120    if addressof:p<>null 
 121      if trace 
 122        compile_log "applying plugin "+name+" "+e:0:ident 
 123      switch_module e:module 
 124      compile 
 125      if p:is_compiled 
 126        suckup p 
 127        set_result p:result p:access 
 128    eif e:size=1 
 129      set_void_result 
 130    else 
 131      e:1:compile 
 132      if e:1:is_compiled 
 133        suckup e:1 
 134        set_result e:1:result e:1:access 
 135       
 136   
 137  export custom plugin