bioperl.lisp

   1
   2 ;; Perl mode set up
   3
   4 (assoc "\\.pl$" auto-mode-alist)
   5 (setq auto-mode-alist (cons '("\\.pl$" . perl-mode) auto-mode-alist))
   6
   7 (assoc "\\.pm$" auto-mode-alist)
   8 (setq auto-mode-alist (cons '("\\.pm$" . perl-mode) auto-mode-alist))
   9
  10 (defun perl-insert-start ()
  11   "Places #!..perl at the start of the script"
  12   (interactive)
  13   (goto-char (point-min))
  14   (insert "#!/usr/local/bin/perl\n"))
  15
  16
  17 (defun bioperl-object-start (perl-object-name perl-caretaker-name caretaker-email)
  18   "Places standard bioperl object notation headers and footers"
  19   (interactive "sName of Object: \nsName of caretaker: \nsEmail: ")
  20   (insert "# $Id: bioperl.lisp,v 1.21 2002-08-22 07:58:17 lapp Exp $\n#\n# BioPerl module for " perl-object-name "\n#\n# Cared for by " perl-caretaker-name " <" caretaker-email ">\n#\n# Copyright " perl-caretaker-name "\n#\n# You may distribute this module under the same terms as perl itself\n\n")
  21   (insert "# POD documentation - main docs before the code\n\n")
  22   (insert "=head1 NAME\n\n" perl-object-name " - DESCRIPTION of Object\n\n")
  23   (insert "=head1 SYNOPSIS\n\nGive standard usage here\n\n")
  24   (insert "=head1 DESCRIPTION\n\nDescribe the object here\n\n")
  25   (insert "=head1 FEEDBACK\n\n=head2 Mailing Lists\n\n")
  26   (insert "User feedback is an integral part of the evolution of this and other\nBioperl modules. Send your comments and suggestions preferably to\nthe Bioperl mailing list.  Your participation is much appreciated.\n\n")
  27   (insert "  bioperl-l@bioperl.org              - General discussion\n  http://bioperl.org/MailList.shtml  - About the mailing lists\n\n")
  28   (insert "=head2 Reporting Bugs\n\nReport bugs to the Bioperl bug tracking system to help us keep track\nof the bugs and their resolution. Bug reports can be submitted via\nemail or the web:\n\n")
  29   (insert "  bioperl-bugs@bioperl.org\n  http://bioperl.org/bioperl-bugs/\n\n")
  30   (insert "=head1 AUTHOR - " perl-caretaker-name "\n\nEmail " caretaker-email "\n\nDescribe contact details here\n\n")
  31   (insert "=head1 CONTRIBUTORS\n\nAdditional contributors names and emails here\n\n")
  32   (insert "=head1 APPENDIX\n\nThe rest of the documentation details each of the object methods.\nInternal methods are usually preceded with a _\n\n=cut\n\n")
  33   (insert "\n# Let the code begin...\n\n")
  34   (insert "\npackage " perl-object-name ";\n")
  35   (insert "use vars qw(@ISA);\n")
  36   (insert "use strict;\n")
  37   (insert "\n# Object preamble - inherits from Bio::Root::Root\n")
  38   (insert "\nuse Bio::Root::Root;\n\n")
  39   (insert "\n@ISA = qw(Bio::Root::Root );\n\n")
  40   (insert "=head2 new\n\n Title   : new\n Usage   : my $obj = new "
  41           perl-object-name "();\n Function: Builds a new "
  42           perl-object-name " object \n Returns : an instance of "
  43           perl-object-name "\n Args    :\n\n\n=cut\n\n")
  44   (insert "sub new {\n  my($class,@args) = @_;\n\n  my $self = $class->SUPER::new(@args);\n  return $self;\n}\n")
  45   (insert "\n\n1;")
  46   )
  47
  48 (defun bioperl-interface-start (perl-object-name perl-caretaker-name
  49                                                  caretaker-email)
  50   "Places standard bioperl object notation headers and footers"
  51   (interactive "sName of Object: \nsName of caretaker: \nsEmail: ")
  52   (insert "# $Id: bioperl.lisp,v 1.21 2002-08-22 07:58:17 lapp Exp $\n#\n# BioPerl module for " perl-object-name "\n#\n# Cared for by " perl-caretaker-name " <" caretaker-email ">\n#\n# Copyright " perl-caretaker-name "\n#\n# You may distribute this module under the same terms as perl itself\n\n")
  53   (insert "# POD documentation - main docs before the code\n\n")
  54   (insert "=head1 NAME\n\n" perl-object-name " - DESCRIPTION of Interface\n\n")
  55   (insert "=head1 SYNOPSIS\n\nGive standard usage here\n\n")
  56   (insert "=head1 DESCRIPTION\n\nDescribe the interface here\n\n")
  57   (insert "=head1 FEEDBACK\n\n=head2 Mailing Lists\n\n")
  58   (insert "User feedback is an integral part of the evolution of this and other\nBioperl modules. Send your comments and suggestions preferably to\nthe Bioperl mailing list.  Your participation is much appreciated.\n\n")
  59   (insert "  bioperl-l@bioperl.org              - General discussion\n  http://bioperl.org/MailList.shtml  - About the mailing lists\n\n")
  60   (insert "=head2 Reporting Bugs\n\nReport bugs to the Bioperl bug tracking system to help us keep track\nof the bugs and their resolution. Bug reports can be submitted via\nemail or the web:\n\n")
  61   (insert "  bioperl-bugs@bioperl.org\n  http://bioperl.org/bioperl-bugs/\n\n")
  62   (insert "=head1 AUTHOR - " perl-caretaker-name "\n\nEmail " caretaker-email "\n\nDescribe contact details here\n\n")
  63   (insert "=head1 CONTRIBUTORS\n\nAdditional contributors names and emails here\n\n")
  64   (insert "=head1 APPENDIX\n\nThe rest of the documentation details each of the object methods.\nInternal methods are usually preceded with a _\n\n=cut\n\n")
  65   (insert "\n# Let the code begin...\n\n")
  66   (insert "\npackage " perl-object-name ";\n")
  67   (insert "use vars qw(@ISA);\n")
  68   (insert "use strict;\nuse Carp;\nuse Bio::Root::RootI;\n\n")
  69   (insert "@ISA = qw( Bio::Root::RootI );")
  70   (insert "\n\n1;")
  71   )
  72
  73
  74 (defun bioperl-method (method-name)
  75   "puts in a bioperl method complete with pod boiler-plate"
  76   (interactive "smethod name:")
  77   (insert "=head2 " method-name "\n\n Title   : " method-name "\n Usage   :\n Function:\n Example :\n Returns : \n Args    :\n\n\n=cut\n\n")
  78   (insert "sub " method-name "{\n   my ($self,@args) = @_;\n")
  79   (save-excursion
  80     (insert "\n\n}\n"))
  81   )
  82
  83
  84 (defun bioperl-getset (field-name)
  85   "puts in a bioperl method for a get/set method complete with pod boiler-plate"
  86   (interactive "sfield name:")
  87   (insert "=head2 " field-name "\n\n Title   : " field-name "\n Usage   : $obj->" field-name "($newval)\n Function: \n Example : \n Returns : value of " field-name " (a scalar)\n Args    : new value (a scalar, optional)\n\n\n=cut\n\n")
  88   (insert "sub " field-name "{\n   my ($self,$value) = @_;\n   if( defined $value) {\n      $self->{'" field-name "'} = $value;\n    }\n    return $self->{'" field-name "'};")
  89   (insert "\n}\n"))
  90
  91
  92 (defun bioperl-abstract-method (method-name)
  93   "puts in a bioperl abstract method for interface classes"
  94   (interactive "smethod-name:")
  95   (save-excursion
  96   (insert "=head2 " method-name "\n\n Title   : " method-name "\n Usage   :\n Function:\n Example :\n Returns : \n Args    :\n\n\n=cut\n\n")
  97   (insert "sub " method-name "{\n   my ($self) = @_;\n\n    $self->throw(\"Abstract method " method-name " implementing class did not provide method\");\n")
  98     (insert "\n\n}\n")
  99     )
 100   )
 101
 102
 103
 104 (setq perl-mode-hook
 105       '(lambda ()
 106          (define-key perl-mode-map "\C-c\C-h" 'perl-insert-start)
 107          (define-key perl-mode-map "\C-c\C-b" 'bioperl-object-start)
 108          (define-key perl-mode-map "\C-c\C-i" 'bioperl-interface-start)
 109          (define-key perl-mode-map "\C-c\C-v" 'bioperl-getset)
 110          (define-key perl-mode-map "\C-c\C-b" 'bioperl-method)
 111          (define-key perl-mode-map "\C-c\C-z" 'compile)
 112          (define-key perl-mode-map [menu-bar] (make-sparse-keymap))
 113          (define-key perl-mode-map [menu-bar p]
 114            (cons "BioPerl" (make-sparse-keymap "BioPerl")))
 115          (define-key perl-mode-map [menu-bar p perl-script-start]
 116            '("Insert script template" . perl-script-start))
 117          (define-key perl-mode-map [menu-bar p bioperl-object-start]
 118            '("bioperl object template" . bioperl-object-start))
 119          (define-key perl-mode-map [menu-bar p bioperl-interface-start]
 120            '("bioperl interface template" . bioperl-interface-start))
 121
 122          (define-key perl-mode-map [menu-bar p bioperl-getset]
 123            '("bioperl field func" . bioperl-getset))
 124          (define-key perl-mode-map [menu-bar p bioperl-method]
 125            '("bioperl method" . bioperl-method))
 126          ))
 127