home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / modes / multi-forms-mode / utilities / soar-misc.el < prev    next >
Encoding:
Text File  |  1992-03-20  |  4.6 KB  |  135 lines
  1. ;;;; -*- Mode: Emacs-Lisp -*- 
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;;; 
  4. ;;;; File            : soar-misc.el
  5. ;;;; Author          : Michael Hucka
  6. ;;;; Created On      : Sun Jun 10 22:13:21 1990
  7. ;;;; Last Modified By: Frank Ritter
  8. ;;;; Last Modified On: Fri Mar 20 19:03:31 1992
  9. ;;;; Update Count    : 28
  10. ;;;; 
  11. ;;;; PURPOSE
  12. ;;;;     Definitions of some missing CL functions from Elisp.
  13. ;;;; Table of contents
  14. ;;;;     I.    line-not-commented 
  15. ;;;;
  16. ;;;; Copyright 1990, Mike Hucka.
  17. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  18. ;;;  changed names of index functions to match trim functions in name order -fer
  19.  
  20. ;;;
  21. ;;;    i.    Initializations and variables
  22. ;;;
  23.  
  24. (require 'cl)
  25. (provide 'soar-misc)
  26.  
  27. (if (fboundp 'proclaim-inline)
  28.   (proclaim-inline
  29.     string-trim
  30.     string-left-trim
  31.     string-right-trim
  32.     string-left-trim-index
  33.     string-right-trim-index
  34.     schar
  35. ))
  36.  
  37.  
  38. ;;;
  39. ;;;     I.    line-not-commented 
  40. ;;;
  41.  
  42. (defun line-not-commented ()
  43.   "Returns t if line does not start with a ;"
  44.   (interactive)
  45.   (save-excursion
  46.     (beginning-of-line)
  47.     (not (looking-at ";"))))
  48.  
  49. ;;; stolen from the net
  50.  
  51. (defun edit-string (s &optional bufname temp bindings)
  52.   "Pops up a buffer to recursively edit STRING.  If terminated using
  53. abort-recursive-edit, the original string is returned.  If terminated with
  54. exit-recursive-edit, the edited string is returned.  Optional 2nd arg
  55. BUFNAME is name of buffer to use.  Optional 3rd arg TEMP non-nil means
  56. kill buffer when done.  Optional last arg BINDINGS is a keymap of
  57. bindings to use in the edit buffer."
  58.   (let ((buf (get-buffer-create (or bufname "*Edit*"))))
  59.         (if bindings (use-local-map bindings))
  60.         (save-window-excursion
  61.           (pop-to-buffer buf)
  62.           (erase-buffer)
  63.           (insert s)
  64.           (beginning-of-buffer)
  65.           (prog1
  66.                   (condition-case e
  67.                           (progn
  68.                                 (recursive-edit)
  69.                                 (buffer-string))
  70.                         (quit s))
  71.                 (if temp (kill-buffer (current-buffer))
  72.                   (bury-buffer))))))
  73.  
  74. ;;; String trimming functions
  75. ;;;-----------------------------------------------------------------------------
  76. ;;; Pieces stolen from PSL/PCLS 3.2 (Stan Shebs/Sandra Loosemore, Univ. of Utah) 
  77.  
  78. (defun string-trim (bag s)
  79.   "Returns a substring of the string specified by S that has had every
  80. character in BAG removed from the beginning and end.  S must be a string or a
  81. symbol.  If S is a symbol, its print name is used as the string.  The BAG
  82. argument may be any sequence of characters.  Characters are trimmed from the
  83. beginning and from the end of S until the first character not in BAG is
  84. found."
  85.   (let* ((len (length s))
  86.      (i1  (string-left-trim-index bag s 0 len))
  87.      (i2  (string-right-trim-index bag s len)))
  88.     (if (<= i2 i1) "" (substring s i1 i2))))
  89.  
  90. ; (string-trim '(?\ ?T) " Tasddf asdf af  ")
  91. ; (string-trim '(?\ ?\t) "  tBype asddf asdf af")
  92.  
  93. (defun string-left-trim (bag s)
  94.   "Returns a substring of the string specified by S that has had every
  95. character in BAG removed from the beginning.  S must be a string or a symbol.
  96. The BAG argument may be any sequence of characters.  Characters are trimmed
  97. from the beginning of S until the first character not in BAG is found."
  98.   (let* ((len (length s))
  99.      (i1  (string-left-trim-index bag s 0 len)))
  100.     (if (<= len i1) "" (substring s i1 len))))
  101.  
  102.  
  103. (defun string-right-trim (bag s) 
  104.   "Returns a substring of the string specified by S that has had every
  105. character in BAG removed from the end.  S must be a string or a symbol.
  106. The BAG argument may be any sequence of characters.  Characters are trimmed
  107. from the end of S until the first character not in BAG is found."
  108.   (let ((i2 (string-right-trim-index bag s (length s))))
  109.     (if (<= i2 0) "" (substring s 0 i2))))
  110.  
  111.  
  112. (defun string-left-trim-index (bag s i uplim)
  113.   (if (or (eql i uplim)
  114.       (not (member (schar s i) bag)))
  115.     i
  116.     (string-left-trim-index bag s (1+ i) uplim)))
  117.  
  118.  
  119. (defun string-right-trim-index (bag s i)
  120.   (if (or (eql i 0)
  121.       (not (member (schar s (1- i)) bag)))
  122.     i
  123.     (string-right-trim-index bag s (1- i))))
  124.  
  125.  
  126. (defun schar (s i)
  127.   "Returns the ITH character of string S as a character object.  S must be
  128. a simple string or a symbol.  If S is a symbol, its print name is used
  129. as the string to operate on.  I must be a non-negative integer less than the
  130. length of the string (indexing is zero-origin).  The function schar applied
  131. to simple strings behaves identically to aref or char, but it may be faster
  132. than either in many implementations."
  133.  
  134.   (string-to-char (substring s i)))
  135.