home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / patn-insert.el < prev    next >
Encoding:
Text File  |  1990-07-22  |  10.0 KB  |  277 lines
  1. ;From utkcs2!emory!samsung!usc!ucsd!rutgers!rochester!cornell!Bard Mon Jun 11 10:06:25 EDT 1990
  2. ;Article 4413 of comp.emacs:
  3. ;Path: utkcs2!emory!samsung!usc!ucsd!rutgers!rochester!cornell!Bard
  4. ;>From: Bard the Emacs Gargoyle
  5. ;Newsgroups: comp.emacs
  6. ;Subject: Patterned-insert.
  7. ;Message-ID: <41976@cornell.UUCP>
  8. ;Date: 10 Jun 90 21:49:02 GMT
  9. ;Sender: nobody@cornell.UUCP
  10. ;Reply-To: bard@cs.cornell.edu (Bard Bloom)
  11. ;Distribution: comp
  12. ;Organization: Cornell Univ. CS Dept, Ithaca NY
  13. ;Lines: 260
  14.  
  15.  
  16. ;; Repetitititive insertion functions.
  17. ;; Copyright (C) 1990 Bard Bloom
  18.  
  19. ;; A gizmo for quickly generating text with a pattern, and in particular 
  20. ;; arithmetic progressions.  For example, you might want to 
  21. ;; create text looking like:
  22. ;;   `a' --> 97     and the square of that is 9409
  23. ;;   `b' --> 98     and the square of that is 9604
  24. ;;   `c' --> 99     and the square of that is 9801
  25. ;;   `d' --> 100     and the square of that is 10000
  26. ;;   `e' --> 101     and the square of that is 10201
  27.  
  28. ;; This was generated by the command
  29. ;; m-x insert-patterned 
  30. ;; with arguments ";;   `%c' --> %d     and the square of that is %(* i i)",
  31. ;;                ?a, 
  32. ;; and            ?e
  33. ;;
  34.  
  35.  
  36.  
  37. ;; This file is is intended for use with GNU Emacs, and may be added to it
  38. ;; if the Free Software Foundation so wishes.
  39.  
  40. ;; GNU Emacs is distributed in the hope that it will be useful,
  41. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  42. ;; accepts responsibility to anyone for the consequences of using it
  43. ;; or for whether it serves any particular purpose or works at all,
  44. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  45. ;; License for full details.
  46.  
  47. ;; Everyone is granted permission to copy, modify and redistribute
  48. ;; GNU Emacs, but only under the conditions described in the
  49. ;; GNU Emacs General Public License.   A copy of this license is
  50. ;; supposed to have been given to you along with GNU Emacs so you
  51. ;; can know your rights and responsibilities.  It should be in a
  52. ;; file named COPYING.  Among other things, the copyright notice
  53. ;; and this notice must be preserved on all copies.
  54.  
  55.  
  56. (require 'cl)
  57.  
  58. (defmacro for-var-low-high (var low high &rest body)
  59.   "For VAR from LOW to HIGH do BODY.  LOW and HIGH are evaluated
  60. once each.  No error checking -- barfs if either isn't a number.
  61. VAR is let-bound."
  62.   (let ((high-save (gensym)))
  63.     (`
  64.      (let (( (, var) (, low))
  65.            ( (, high-save) (, high))
  66.            )
  67.        (while (<= (, var) (, high-save))
  68.          (,@ body)
  69.          (incf (, var))
  70.          )))))
  71.  
  72. (defun insert-patterned (pattern low high &optional no-line-breaks)
  73.   "
  74. Insert lines with a similar structure but some variation into the file.
  75. It repeatedly inserts PATTERN in the file, varying the global variable i 
  76. from LOW to HIGH.  PATTERN is used somewhat as a format.  If the following 
  77. constructs occur within the PATTERN, they are replaced by appropriate 
  78. string:
  79.   %d,%i -- index as number
  80.   %c -- index as char
  81.   %(X) -- eval the expression (X), insert its value (made into a string)
  82.   %% -- a %-sign
  83.   %[X] -- the value of the expression X, made into a string.  
  84.   %[X c] -- the value of the expression X, printed with format c.
  85.  
  86. For example, with
  87.   PATTERN = \"   a[%i] := %(* 2 i); \"
  88.   LOW     = 0
  89.   HIGH    = 3
  90. this command would insert 
  91.    a[0] := 0; 
  92.    a[1] := 2; 
  93.    a[2] := 4; 
  94.    a[3] := 6; 
  95.  
  96. Interactively, LOW and HIGH are evaluated expressions:
  97.  PATTERN = \"   ascii_%c := %i; \"
  98.  LOW     = ?a
  99.  HIGH    = ?d
  100. would insert
  101.    ascii_a := 97; 
  102.    ascii_b := 98; 
  103.    ascii_c := 99; 
  104.    ascii_d := 100; 
  105.  
  106. A simple hex ASCII table could be generated with 
  107.  PATTERN = \"  %c - %[i 2x]\".
  108. The pattern %[i 2x] prints the value of the expression i according to the format 
  109. string `%2x', which is two-place hexadecimal.  See `format' for more details.
  110.  
  111. There is a good deal of overlap between the %(...) and %[... ...] patterns.
  112. %(X) and %[(X)] are identical.  The %[...] can be used for inserting the values
  113. of variables --- %[x] inserts the value of x, while %(x) tries to call the function
  114. x --- and the second argument in the %[...] construct can specify a format.
  115.  
  116. If the prefix argument NO-LINE-BREAKS is true, then the insertions 
  117. are not separated by anything; otherwise, they are separated by line-breaks.
  118.  
  119. "
  120.   (interactive "sPattern: \nXFrom: \nXTo: \nP")
  121.   (let* ((format+args (insert-pattern-internal pattern 1))
  122.          (fmt (first format+args))
  123.          (args (second format+args)))
  124.     (for-var-low-high i low high
  125.                       (insert
  126.                        (apply (function format) fmt (mapcar (function eval) args))
  127.                        (if no-line-breaks "" "\n"))
  128.                       ))
  129. )
  130.  
  131.  
  132. (defun insert-patterned-2 (pattern lowi highi lowj highj &optional no-line-breaks)
  133.   "
  134. Very much like insert-patterned, except that it has two variables i and j.
  135. i varies more slowly than j.  Patterns are the same as insert-pattern (q.v.)
  136. except that we also allow:
  137.   %j -- second index as number.
  138. If you want to insert j as a character, use %[j c].
  139. "
  140.   (interactive "sPattern: \nX i from: \nXi to: \nX j from: \nX j to:\nP")
  141.   (let* ((format+args (insert-pattern-internal pattern 2))
  142.          (fmt (first format+args))
  143.          (args (second format+args)))
  144.     (for-var-low-high i lowi highi
  145.       (for-var-low-high j lowj highj
  146.                         (insert
  147.                          (apply (function format) fmt (mapcar (function eval) args))
  148.                          (if no-line-breaks "" "\n"))
  149.                         ))))
  150.  
  151. (defun insert-patterned-3 (pattern lowi highi lowj highj lowk highk &optional no-line-breaks)
  152.   "
  153. Very much like insert-patterned, except that it has three variables: i,j,k.
  154. i varies more slowly than j, which is in turn slower than k.
  155. Patterns are the same as insert-pattern (q.v.)
  156. except that we also allow:
  157.   %j -- second index as number.
  158.   %k -- third index as number
  159. If you want to insert j as a character, use %[j c].
  160. "
  161.   (interactive "sPattern: \nX i from: \nXi to: \nX j from: \nX j to:\nX k from: \nX k to:\nP")
  162.   (let* ((format+args (insert-pattern-internal pattern 3))
  163.          (fmt (first format+args))
  164.          (args (second format+args)))
  165.     (for-var-low-high i lowi highi
  166.       (for-var-low-high j lowj highj
  167.         (for-var-low-high k lowk highk
  168.                         (insert
  169.                          (apply (function format) fmt (mapcar (function eval) args))
  170.                          (if no-line-breaks "" "\n"))
  171.                         )))))
  172.  
  173. (defun insert-patterned-4 (pattern lowi highi lowj highj lowk highk
  174.                                    lowl highl &optional no-line-breaks)
  175.   "
  176. Very much like insert-patterned, except that it has four variables: i,j,k,l.
  177. i varies more slowly than j, which is in turn slower than k, and 
  178. l is fastest.
  179. Patterns are the same as insert-pattern (q.v.)
  180. except that we also allow:
  181.   %j -- second index as number.
  182.   %k -- third index as number
  183.   %l -- fourht index as number.
  184. If you want to insert j as a character, use %[j c].
  185. "
  186.   (interactive "sPattern: \nX i from: \nXi to: \nX j from: \nX j to:\nX k from: \nX k to:\nX l from: \nX l to: \nP")
  187.   (let* ((format+args (insert-pattern-internal pattern 4))
  188.          (fmt (first format+args))
  189.          (args (second format+args)))
  190.     (for-var-low-high i lowi highi
  191.       (for-var-low-high j lowj highj
  192.         (for-var-low-high k lowk highk
  193.           (for-var-low-high l lowl highl
  194.                         (insert
  195.                          (apply (function format) fmt (mapcar (function eval) args))
  196.                          (if no-line-breaks "" "\n"))
  197.                         ))))))
  198.  
  199.  
  200.  
  201. (defun string-cdr (s)
  202.   (cond
  203.    ((<= (length s) 1) "")
  204.    (t (substring s 1))))
  205.  
  206. (defun convert-to-string (x)
  207.   "Convert X to a string.  If X is an integer, it is treated as an integer
  208. rather than a character: (2str ?a) ==> \"97\".  X can be anything, but the conversion
  209. isn't necessarily all that smart."
  210.   (cond
  211.    ((stringp x) x)
  212.    ((symbolp x) (symbol-name x))
  213.    ((numberp x) (int-to-string x))
  214.    (t (prin1-to-string x))))
  215.  
  216. (defun insert-pattern-internal (pattern nloops)
  217.   (let ((args '())
  218.         (pattern-tail pattern)
  219.         (p "")
  220.         m rfs
  221.         insert-command
  222.         )
  223.     (while (setq m (string-match "^\\([^%]*\\)%\\(.\\)" pattern-tail))
  224.       (setq p (concat p (substring pattern-tail (match-beginning 1) (match-end 1)) "%"))
  225.       (setq pattern-tail (substring pattern-tail (match-beginning 2)))
  226.       (case (string-to-char pattern-tail)
  227.         (?% (setq p (concat p "%")))
  228.         ((?c ?d)
  229.          (push 'i args)
  230.          (setq p (concat p (substring pattern-tail 1 1)))
  231.          )
  232.         ((?\[)
  233.          (setq rfs (read-from-string pattern-tail))
  234.          (setq pattern-tail (substring pattern-tail (cdr rfs)))
  235.          (cond
  236.           ((= (length (car rfs)) 1)
  237.            (setq p (concat p "s"))
  238.            (push (list 'convert-to-string (aref (car rfs) 0)) args))
  239.           ((= (length (car rfs)) 2)
  240.            (setq p (concat p (convert-to-string (aref (car rfs) 1))))
  241.            (push (aref (car rfs) 0) args))
  242.           (t
  243.            (error "I don't understand the pattern %s" (convert-to-string rfs)))))
  244.         ((?i)
  245.          (push 'i args)
  246.          (setq pattern-tail (string-cdr pattern-tail))
  247.          (setq p (concat p "d")))
  248.         ((?j)
  249.          (when (< nloops 2) (error "No j index -- only %d loops" nloops))
  250.          (push 'j args)
  251.          (setq pattern-tail (string-cdr pattern-tail))
  252.          (setq p (concat p "d")))
  253.         ((?k)
  254.          (when (< nloops 3) (error "No k index -- only %d loops" nloops))
  255.          (push 'k args)
  256.          (setq pattern-tail (string-cdr pattern-tail))
  257.          (setq p (concat p "d")))
  258.         ((?l)
  259.          (when (< nloops 4) (error "No l index -- only %d loops" nloops))
  260.          (push 'l args)
  261.          (setq pattern-tail (string-cdr pattern-tail))
  262.          (setq p (concat p "d")))
  263.         (?\(
  264.          (setq rfs (read-from-string pattern-tail))
  265.          (setq pattern-tail (substring pattern-tail (cdr rfs)))
  266.          (setq p (concat p "s"))
  267.          (push (list 'convert-to-string (car rfs)) args))
  268.         (t
  269.          (setq p (concat p (substring pattern-tail 1 1)))
  270.          (push 'i args)))
  271.  
  272.       )
  273.     (list (concat p pattern-tail) (reverse args))
  274.     ))
  275.  
  276.  
  277.