home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD1.bin / new / util / edit / jade / src / commands.c < prev    next >
C/C++ Source or Header  |  1994-10-06  |  16KB  |  575 lines
  1. /* commands.c -- Interactive calling of commands/functions
  2.    Copyright (C) 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4.    This file is part of Jade.
  5.  
  6.    Jade is free software; you can redistribute it and/or modify it
  7.    under the terms of the GNU General Public License as published by
  8.    the Free Software Foundation; either version 2, or (at your option)
  9.    any later version.
  10.  
  11.    Jade is distributed in the hope that it will be useful, but
  12.    WITHOUT ANY WARRANTY; without even the implied warranty of
  13.    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14.    GNU General Public License for more details.
  15.  
  16.    You should have received a copy of the GNU General Public License
  17.    along with Jade; see the file COPYING. If not, write to
  18.    the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. #include "jade.h"
  21. #include "jade_protos.h"
  22.  
  23. #include <string.h>
  24.  
  25. _PR void commands_init(void);
  26.  
  27. /* Symbols of the Lisp functions called to get input. */
  28. static VALUE sym_prompt_for_function, sym_prompt_for_buffer,
  29.     sym_prompt_for_char, sym_prompt_for_command, sym_prompt_for_directory,
  30.     sym_prompt_for_file, sym_prompt_for_number, sym_prompt_for_string,
  31.     sym_prompt_for_symbol, sym_prompt_for_variable, sym_prompt_for_lisp,
  32.     sym_read_event;
  33.  
  34. static VALUE sym_interactive;
  35.  
  36. /* Prefix argument for the next command and the current command. */
  37. static VALUE prefix_arg, current_prefix_arg;
  38.  
  39. /* Command being executed and command last executed. */
  40. _PR VALUE this_command, last_command;
  41. VALUE this_command, last_command;
  42.  
  43. _PR VALUE var_this_command(VALUE val);
  44. DEFUN("this-command", var_this_command, subr_this_command, (VALUE val), V_Var, DOC_this_command) /*
  45. ::doc:this_command::
  46. This variable holds the command currently being evaluated, or nil if no
  47. command is active. The `command' is whatever is being evaluated; it could
  48. be a function, a form or even a list of forms (from a menu).
  49. ::end:: */
  50. {
  51.     if(val)
  52.     this_command = val;
  53.     return(this_command);
  54. }
  55.  
  56. _PR VALUE var_last_command(VALUE val);
  57. DEFUN("last-command", var_last_command, subr_last_command, (VALUE val), V_Var, DOC_last_command) /*
  58. ::doc:last_command::
  59. This variable holds the last interactive command evaluated. This will either
  60. be from a keybinding or a menu. Setting the value of the `next-keymap-path'
  61. variable is not considered a command. After a command finishes this variable
  62. takes the value of `this-command'.
  63. ::end:: */
  64. {
  65.     if(val)
  66.     last_command = val;
  67.     return(last_command);
  68. }
  69.  
  70. _PR VALUE var_prefix_arg(VALUE val);
  71. DEFUN("prefix-arg", var_prefix_arg, subr_prefix_arg, (VALUE val), V_Var, DOC_prefix_arg) /*
  72. ::doc:prefix_arg::
  73. Value of the prefix argument for the next command.
  74. ::end:: */
  75. {
  76.     if(val)
  77.     prefix_arg = val;
  78.     return(prefix_arg);
  79. }
  80.  
  81. _PR VALUE var_current_prefix_arg(VALUE val);
  82. DEFUN("current-prefix-arg", var_current_prefix_arg, subr_current_prefix_arg, (VALUE val), V_Var, DOC_current_prefix_arg) /*
  83. ::doc:current_prefix_arg::
  84. Value of the prefix argument for the current command.
  85. ::end:: */
  86. {
  87.     if(val)
  88.     current_prefix_arg = val;
  89.     return(current_prefix_arg);
  90. }
  91.  
  92. /* Search the definition of the command CMD for an interactive calling
  93.    spec. Return it or NULL. */
  94. static VALUE
  95. interactive_spec(VALUE cmd)
  96. {
  97.     VALUE fun, spec = NULL;
  98.     if(SYMBOLP(cmd))
  99.     fun = cmd_symbol_function(cmd, sym_t);
  100.     else
  101.     fun = cmd;
  102.     if(!VOIDP(fun) && !NILP(fun))
  103.     {
  104.     if((VTYPE(fun) >= V_Subr0) && (VTYPE(fun) <= V_SubrN))
  105.         spec = VSUBR(fun)->subr_IntSpec;
  106.     else if(CONSP(fun))
  107.     {
  108.         if(VCAR(fun) == sym_autoload)
  109.         {
  110.         VALUE tmp = move_down_list(fun, 2);
  111.         if(CONSP(tmp) && !NILP(VCAR(tmp)))
  112.         {
  113.             GCVAL gcv_cmd;
  114.             PUSHGC(gcv_cmd, cmd);
  115.             fun = load_autoload(cmd, fun);
  116.             POPGC;
  117.             if(!fun || !CONSP(fun))
  118.             return(NULL);
  119.         }
  120.         else
  121.             return(NULL);
  122.         }
  123.         if(VCAR(fun) == sym_lambda)
  124.         {
  125.         /* A lambda expression, test its first proper form. */
  126.         fun = move_down_list(fun, 2);
  127.         if(CONSP(fun)
  128.            && (STRINGP(VCAR(fun)) || NUMBERP(VCAR(fun)))
  129.            && CONSP(VCDR(fun)))
  130.         {
  131.             /* A doc-string */
  132.             fun = VCDR(fun);
  133.         }
  134.         if(CONSP(fun))
  135.         {
  136.             fun = VCAR(fun);
  137.             if(CONSP(fun)
  138.                && (VCAR(fun) == sym_interactive))
  139.             {
  140.             /* got it. */
  141.             spec = CONSP(VCDR(fun)) ? VCAR(VCDR(fun)) : sym_nil;
  142.             }
  143.         }
  144.         }
  145.     }
  146.     }
  147.     return(spec);
  148. }
  149.  
  150. _PR VALUE cmd_call_command(VALUE cmd, VALUE arg);
  151. DEFUN_INT("call-command", cmd_call_command, subr_call_command, (VALUE cmd, VALUE cmd_arg), V_Subr2, DOC_call_command, "CEnter command:\nP") /*
  152. ::doc:call_command::
  153. call-command COMMAND [PREFIX-ARG]
  154.  
  155. Invoke the command COMMAND. This can be one of,
  156.  1. A symbol whose function value is to be called, the symbol must be of
  157.     type `commandp'; any interactive calling specification will be
  158.     used to find arguments to give to the function. (see `interactive')
  159.  2. A lambda-expression to call as a function name
  160.  3. A single Lisp form to be evaluated by eval
  161.  
  162. If PREFIX-ARG is non-nil it specifies the value of the COMMAND's
  163. current-prefix-arg. This is used in call-command's interactive spec so that
  164. any entered arg is given to the invoked COMMAND.
  165. ::end:: */
  166. {
  167.     VALUE res = NULL;
  168.     this_command = cmd;
  169.     if(last_command == sym_t)
  170.     undo_distinct();        /* last was an insertion */
  171.     undo_new_group();
  172.  
  173.     /* Move the prefix arg. */
  174.     if(NILP(cmd_arg))
  175.     cmd_arg = prefix_arg;
  176.     prefix_arg = sym_nil;
  177.     current_prefix_arg = cmd_arg;
  178.  
  179.     if(SYMBOLP(cmd) || (CONSP(cmd) && VCAR(cmd) == sym_lambda))
  180.     {
  181.     /* A named command; call it properly taking note of any interactive
  182.        declaration. */
  183.     VALUE int_spec = interactive_spec(cmd);
  184.     VALUE args = sym_nil;
  185.     VALUE *argsp = &args;
  186.     GCVAL gcv_cmd;
  187.     bool clear_block = FALSE;
  188.     if(int_spec == NULL)
  189.     {
  190.         cmd_signal(sym_error, list_2(MKSTR("Not a command"), cmd));
  191.         goto exit;
  192.     }
  193.     PUSHGC(gcv_cmd, cmd);
  194.     if(STRINGP(int_spec))
  195.     {
  196.         u_char *spec_str = VSTR(int_spec);
  197.         u_char c;
  198.         GCVAL gcv_args;
  199.         while(1)
  200.         {
  201.         /* check for read-only flag */
  202.         if(*spec_str == '*')
  203.         {
  204.             if(read_only(curr_vw->vw_Tx))
  205.             {
  206.             POPGC;
  207.             goto exit;
  208.             }
  209.             else
  210.             spec_str++;
  211.         }
  212.         else if(*spec_str == '-')
  213.         {
  214.             /* clear block after building args. */
  215.             clear_block = TRUE;
  216.             spec_str++;
  217.         }
  218.         else
  219.             break;
  220.         }
  221.         PUSHGC(gcv_args, args);
  222.         while((c = *spec_str++) != 0)
  223.         {
  224.         VALUE prompt, arg = sym_nil;
  225.         if(c != '\n')
  226.         {
  227.             /* Non-null code. */
  228.             bool can_be_nil = FALSE;
  229.             if(*spec_str == '\n')
  230.             {
  231.             /* no prompt */
  232.             prompt = sym_nil;
  233.             spec_str++;
  234.             }
  235.             else
  236.             {
  237.             /* copy the prompt */
  238.             u_char *end = memchr(spec_str, '\n',
  239.                          STRING_LEN(int_spec) -
  240.                          (spec_str - VSTR(int_spec)));
  241.             if(!end)
  242.                 end = VSTR(int_spec) + STRING_LEN(int_spec);
  243.             prompt = string_dupn(spec_str, end - spec_str);
  244.             if(memchr(spec_str, '%', end - spec_str))
  245.             {
  246.                 /* Format characters; format it. */
  247.                 prompt = cmd_format(cmd_cons(sym_nil,
  248.                              cmd_cons(prompt, args)));
  249.                 if(!prompt || !STRINGP(prompt))
  250.                 prompt = string_dupn(spec_str, end - spec_str);
  251.             }
  252.             spec_str = *end ? end + 1 : end;
  253.             }
  254.             switch(c)
  255.             {
  256.             case 'a':
  257.             arg = call_lisp1(sym_prompt_for_function, prompt);
  258.             break;
  259.             case 'b':
  260.             arg = call_lisp2(sym_prompt_for_buffer, prompt, sym_t);
  261.             break;
  262.             case 'B':
  263.             arg = call_lisp1(sym_prompt_for_buffer, prompt);
  264.             break;
  265.             case 'c':
  266.             arg = call_lisp1(sym_prompt_for_char, prompt);
  267.             break;
  268.             case 'C':
  269.             arg = call_lisp1(sym_prompt_for_command, prompt);
  270.             break;
  271.             case 'd':
  272.             arg = cmd_cursor_pos();
  273.             break;
  274.             case 'D':
  275.             arg = call_lisp1(sym_prompt_for_directory, prompt);
  276.             break;
  277.             case 'e':
  278.             arg = cmd_current_event();
  279.             break;
  280.             case 'E':
  281.             arg = cmd_current_event_string();
  282.             break;
  283.             case 'f':
  284.             arg = call_lisp2(sym_prompt_for_file, prompt, sym_t);
  285.             break;
  286.             case 'F':
  287.             arg = call_lisp1(sym_prompt_for_file, prompt);
  288.             break;
  289.             case 'k':
  290.             arg = call_lisp1(sym_read_event, prompt);
  291.             break;
  292.             case 'm':
  293.             case 'M':
  294.             arg = (c == 'm') ? cmd_block_start(sym_nil)
  295.                              : cmd_block_end(sym_nil);
  296.             if(!arg || NI