home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Completions / PerlCompletions.tcl < prev    next >
Encoding:
Text File  |  1997-11-05  |  4.8 KB  |  119 lines  |  [TEXT/ALFA]
  1. ## 
  2.  # This    file will be sourced automatically, immediately after 
  3.  # the _first_ time    the    file which defines its mode is sourced.
  4.  # Use this file to declare completion items and procedures
  5.  # for this mode.
  6.  # 
  7.  # Some common defaults are included below.
  8.  ##
  9.  
  10. set Perlcmds { ARGV BEGIN accept alarm atan2 autoflush binmode bless
  11. caller chdir chmod chomp chown chroot close closedir connect continue crypt
  12. dbmclose dbmopen defined delete elsif endgrent endhostent endnetent
  13. endprotoent endpwent endservent exists fcntl fileno flock foreach
  14. format_formfeed format_line_break_characters format_lines_left
  15. format_lines_per_page format_name format_page_number format_top_name
  16. formline getgrent getgrgid getgrnam gethostbyaddr gethostbyname gethostent
  17. getlogin getnetbyaddr getnetbyname getnetent getpeername getpgrp getppid
  18. getpriority getprotobyname getprotobynumber getprotoent getpwent getpwnam
  19. getpwuid getservbyname getservbyport getservent getsockname getsockopt
  20. gmtime import index input_line_number input_record_separator ioctl lcfirst
  21. length listen local localtime lstat mkdir msgctl msgget msgrcv msgsnd
  22. opendir output_field_separator output_record_separator package print printf
  23. quotemeta readdir readlink rename require reset return reverse rewinddir
  24. rindex rmdir scalar seekdir select semctl semget semop setgrent sethostent
  25. setnetent setpgrp setpriority setprotoent setpwent setservent setsockopt
  26. shift shmctl shmget shmread shmwrite shutdown sleep socket socketpair
  27. splice split sprintf srand study substr symlink syscall sysread system
  28. syswrite telldir times truncate ucfirst umask undef unless unlink unpack
  29. unshift untie until utime values waitpid wantarray while write }
  30.  
  31. set completions(Perl) {contraction completion::cmd Electric Var}
  32.  
  33. set Perlelectrics(for) " (•start•;•test•;•increment•)\{\n\t•body•\n\}\n••"
  34. set Perlelectrics(foreach) "$•scalar• (@•array•)\{\n\t•body•\n\}\n••"
  35. set Perlelectrics(while) " (@•array•)\{\n\t•body•\n\}\n••"
  36. set Perlelectrics(if) " (•condition•)\{\n\t•body•\n\} ••"
  37. set Perlelectrics(else) " \{\n\t•else body•\n\} ••"
  38. set Perlelectrics(elsif) " (•condition•)\{\n\t•else body•\n\} ••"
  39. set Perlelectrics(do) " \{••\n\t••\n\} while (•test•);\n••"
  40.  
  41. # alternative defs of above -trf
  42. set Perlelectrics(while) " (•test•) \{\r\t•body•\r\}\r••"
  43. set Perlelectrics(foreach) " \$•loopVar• (•listReturner•) \{\r\t•body•\r\}\r••"
  44.  
  45. # ◊◊◊◊ functions ◊◊◊◊ #
  46. set Perlelectrics(split) "(\"•at-these-chars•\", •string-returner•)••"
  47.  
  48. # ◊◊◊◊ contractions ◊◊◊◊ #
  49. set Perlelectrics(o'd) "◊kill0open(•hndlName•, \"•fileName•\") or die \"Can't open •fileName•: $!\"\n"
  50.  
  51. # ◊◊◊ bind ◊◊◊◊ #
  52. bind 0x15 <z> addRemoveDollars Perl
  53.  
  54.  
  55. ##
  56.  # -------------------------------------------------------------------------
  57.  #
  58.  #    "Perl::Completion::Var" --
  59.  #
  60.  #     A mildly adaptive call    of completion::word, in which    we realise we
  61.  #     should    complete '$abc...' if we can only see 'abc...'.     The standard
  62.  #     procedure consider    '$'    to be part of a    word so    that would otherwise
  63.  #     fail.  Also handles '%', '@' and '*'.
  64.  # -------------------------------------------------------------------------
  65.  ##
  66. proc Perl::Completion::Var {dummy} {
  67.     global __wc__insPos completion_got completion_looking
  68.     
  69.     # cursor changed place?
  70.     set pos [getPos]
  71.     if $pos==$__wc__insPos {
  72.         return [completion::update Perl::Completion::Var $completion_got $completion_looking]
  73.     }
  74.  
  75.     set lastword [completion::lastWord]
  76.     if [containsSpace $lastword] {return 0}
  77.     set possPrefix [string index $lastword 0]
  78.     if {[string first $possPrefix "\$%@*"] != -1 } {
  79.         set completion_got [string range $lastword 1 end]
  80.         set completion_looking $completion_got
  81.         return [completion::update Perl::Completion::Var $completion_got $completion_looking]
  82.     } else {
  83.         return [completion::update completion::word]
  84.     }
  85. }
  86.  
  87. ## 
  88.  # -------------------------------------------------------------------------
  89.  # 
  90.  # "identifiersToScrap_Perl" --
  91.  # 
  92.  #  This is useful when you want to check for spelling mistakes in identifiers
  93.  #  (can be used with "cannonize"). Also, provides a handy way to make all the 
  94.  #  identifiers available to another file so you can use the completion/expansion
  95.  #  routines. Just paste them in whatever file you like. (Invoke from command line)
  96.  # -------------------------------------------------------------------------
  97.  ##
  98. proc identifiersToScrap_Perl {} {
  99.     set id_pat {([$@%*]\w+)|(<\w+>)}
  100.     set pos 0
  101.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 $id_pat $pos} res]} {
  102.         append idents [eval getText $res] " "
  103.         set pos [expr [lindex $res 1] +1]
  104.     }
  105.     if {[info exist idents]} {
  106.         set idents [lunique $idents]
  107.         set idents [lsort -command sortByIgnoringFirstChar $idents]
  108.         regsub -all {\{} $idents "" idents
  109.         regsub -all {\}} $idents "" idents
  110. #         regsub -all {\{([^\}])*\}} $idents "" idents
  111.         putScrap "# $idents"
  112.     } 
  113.     
  114. }
  115.  
  116. proc sortByIgnoringFirstChar {one two} {
  117.     string compare [string tolower [string range $one 1 end]] \
  118.       [string tolower [string range $two 1 end]]
  119. }