Trailing-Edge - PDP-10 Archives - mit_emacs_170_teco_1220 - emacs/lsputl.emacs
There are no other files named lsputl.emacs in the archive.
!* -*-TECO-*- *!

!~Filename~:! !Lisp Utilities!
!Find Pat:! !C Searches for an sexpression containing some character sequences.
Supply a sequence of string args and a numeric arg, e.g.,
C-U 1 M-X Find PatFOOBAR1BAR2<cr>.
Searches for FOO.  At each occurrence of FOO,
if the list up <numeric arg> levels of list structure from the FOO
also contains the other string args (BAR1 and BAR2 in this example),
moves point there and queries:

    Altmode or Period stops
    C-L Refreshes
    C-R Enters a recursive edit
    Space and Rubout resume searching for another such sexpression
    Everything else stops search and is reread as a command.!


  10 F[ % CENTER	    !* Puts start of sexprs found near screen top!

  [..J :I..J Find_Pat

  :IA		    !* Read first string arg into A!

     !* Build (and place in QT) a string of!
     !* the form 1:<QJ,QZFBpat2$QJ,QZFBpat3$...>!
     !* (QJ will hold the start and QZ the end of the sexpression!
     !* under consideration.)!
     !* When executed, QT will return 0 iff one of the searches fail!

     :IT >

    !READ!		    !* Loop to read args!
      :IR		    !* Get next string arg!
      			    !* If not empty, splice it in and loop!
    :IT 1:<T		    !* Close it off!

  !TOP!				    !* Loop to find sexpressions!

  :SA"E '		    !* Find first string or quit!

  FKC			    !* Move to start of string!
  .+1UN			    !* Setup position for next try in N!
  -FU UQ UJ		    !* Write sexp start into J!
			    !* Q is ignored!
  FU UZ		    !* Write sexp end into Z!
  MT"N			    !* Macro the search command!
   QNJ			    !* Start over if it fails!

  QJJ			    !* We have a candidate sexpression!

  !* Show the buffer with point at J, then query!

  !CHAR!		    !* Character reading loop!
  2,M.I @:FIU1 FIU0	    !* Get character from tty in two ways!
  Q0-"E '		    !* Altmode or Period stops!
  q0-."E '
  Q0-"E 0 OCHAR'	    !* ^R enters a recursive edit!
  Q0-12"E F+ OCHAR'	    !* ^L refreshes the screen!
  q0-32"E QZ,QN F J OTOP'	    !* space continues!
  q0-127"E QZ,QN F J OTOP'	    !* delete continues!
  Q1FS REREAD		    !* everything else quits and is reread.!

!^R Extract Sublist:! !^R Replace superior sexp with sexp after point.
Arg indicates how many levels up.!


  !* Calculate areas to kill, ringing bell and exiting if inappropriate!

  .UJ				    !* Save current location in J!
  1:<- FUL>"N FG 0' 	    !* Back up and!
  .UA  				    !* make sure there is a whole!
  1:<1 FLR>"N FG 0'		    !* expression up above us.!
  .UZ				    !* A is start and Z is end of superior exp!
  QJJ				    !* Now back to where we were.!
  1@FLL				    !* . is end of inferior expr!

  !* Setup undo info!
  Q..O U: ..U(0)		    !* Current buffer!
  QA,QZ X Y			    !* Superior expression!
  QY U: ..U(1)
  QA U: ..U(2)			    
  Z-QZ U: ..U(3)		    !* Undo's encoding of end!
  :I*Extract U: ..U(4)		    !* Command Undo will query about!

  !* Do the killing!

  .,QZK				    !* Kill last part of superior expr!
  QA,QJK			    !* Kill first part of superior expr!

!^R Frob LISP conditional:! !^R Change CONDs to ANDs and vice versa.
When changing to COND, point is left in such a place that LF will add another
clause to this condition, and M-) will add another condition.  Also in this case
an argument specifies the number of clauses that are left in the
consequent, the default is 1, i.e. all clauses but the last are assumed to
be for value, and to belong in the antecedent.
A pre-comma argument specifies the search count for finding it (default is -1).!

    ff&2"e -1' "# ' [a z-.[b  !* Compute the right arg.!
    qa :s(COND(AND(OR[0  !* Search for last frob!
    q0"e @fe SFLfs err'	    !* Didnt find one, complain!
    qa"g fk+1' c 1a"'u[1 .[2	    !* Move to start of the atom and remember if uppercase!
    z-qbj 0[c qa"l :s
(  fkc .[d -:s
(  < .-qd; 0,qdfuc>	    !* Compute paren depth of end of defun!
    qc&777777.uc z-qbj'
    qc"n i
   qc,)i i
   z-.ud' q2j			    !* And balance it at point!
    q0+1"e @fwk 2fdl		    !* COND case, flush it!
      :sNOTNULL+3"g	    !* Check for (COND ((NOT etc!
        -ful .( @fll -d) j d @fwk   !* Delete the NOT and associated level of parens!
	@f_	k q2j	    !* And any whitespace!
	i OR'			    !* Choose the right new conditional!
      "# q2j i AND'
      @f_	l		    !* Skip over blanks!
      .( @fll -d) j d'		    !* Remove a level of parens!
    "# r @fll -fdl )i r 0[3	    !* Go to the end of the last clause!
      < -@fll q2-.; %3> q2j	    !* Move back to AND or OR, counting sexps!
      ff&1"e 0' "# 1-'[4	    !* Figure number of sexps to leave after paren!
      q4+q3-3"l @fwk i COND	    !* Just one clause, make it the COND clause!
        :@fll (i'		    !* And put in another open paren!
      "# i COND_(( .(		    !* Else leave the AND or OR in!
        q4f"g w ful' "# +q3 @fll'
	)i )-1j'		    !* Put the matching paren where requested!
      q0+3"e .( @fll )i )j i (NOT_''	    !* Make ORs into (COND ((NOT ...!
    q1"e q2,. fc'		    !* Lowercase area if necessary!
    q0+3"e -2' "# -' ful	    !* Move out of stuff we hacked!
    @m(m.m^r_indent_sexp)	    !* Regrind it!
    @fll -fdl .u2		    !* Leave point to after the last clause!
    qc"n z-qdj -k -2d q2-."g z-qbj ''