home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / unix / volume11 / test.el / part01 / tst-inequal.el < prev    next >
Lisp/Scheme  |  1987-09-08  |  4KB  |  137 lines
  1. ;;; inequal.el -- A number of inequality functions. 
  2. ;;; See also equal.el
  3. ;;; Lorri Menard, Wang Institute of Graduate Studies
  4. ;;; Don Zaremba, Wang Institute of Graduate Studies
  5. ;;; Copyright 1987 Wang Institute of Graduate Studies
  6. ;;;
  7.  
  8. (provide 'tst-inequal)
  9.  
  10. ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  11.  
  12. (defun string-equal-less-white  (str1 str2)
  13.   " Returns t if the two strings are equal after ignoring whitespace."
  14.  
  15.   (let  ()
  16.     (string-equal-less-regexp "\\s " str1 str2)
  17.   ) ; let
  18. ) ; line-of-buffer
  19.  
  20.  
  21. ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  22.  
  23. (defun string-equal-less-regexp  (regexp str1 str2)
  24.   " Returns t if the two strings are equal after ignoring all substrings
  25.     that match regexp ."
  26.  
  27.   (let  (start1 end1  start2 end2 token1 token2 success more1 more2)
  28.     (setq  success t more1 t more2 t)
  29.     (setq start1 (first-not-regexp regexp str1 0)); move to 1st non-white
  30.     (setq start2 (first-not-regexp regexp str2 0)); move to 1st non-white
  31.  
  32.     (while (and more1 more2)
  33.       (progn
  34.      (setq end1 (string-match regexp str1 start1))
  35.      (setq end2 (string-match regexp str2 start2))
  36.      (if end1
  37.          (progn         ; end1 not nil 
  38.            (setq token1 (substring str1 start1 end1))
  39.            (setq start1 (first-not-regexp regexp str1 end1))
  40.            (if (not start1)  ; check for trailing delimiter only
  41.            (setq more1 nil))
  42.            ); progn
  43.           ;else
  44.          (progn
  45.            (setq token1 (substring str1 start1 nil));
  46.            (setq more1 nil)
  47.            ); progn
  48.      ); if
  49.      (if end2
  50.          (progn         ; end2 not nil 
  51.            (setq token2 (substring str2 start2 end2))
  52.            (setq start2 (first-not-regexp regexp str2 end2))
  53.            (if (not start2)  ; check for trailing delimiter only
  54.            (setq more2 nil))
  55.            ); progn
  56.           ;else
  57.          (progn
  58.            (setq token2 (substring str2 start2 nil));
  59.            (setq more2 nil)
  60.            ); progn
  61.      ); if
  62. ;      (send-string-to-terminal "[")
  63. ;        (send-string-to-terminal token1)
  64. ;        (send-string-to-terminal "][")
  65. ;        (send-string-to-terminal token2)
  66. ;        (send-string-to-terminal "]")
  67.      (setq success (string-equal token1 token2))
  68.      (if (not success)
  69.          (setq more1 nil)) ; if failed then stop the loop
  70.       ); progn
  71.     ) ; while
  72.     (and (not more1) (not more2) success)
  73.   ) ; let
  74. ) ; string-equal-less-white
  75.  
  76.  
  77. ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  78.  
  79. (defun first-not-regexp (regexp str sindex)
  80.   " Returns the index of the first char in string that does not match
  81.     regular expression. Returns nil if nothing doesn't match."
  82.  
  83.   (let  (fm more string-is-nil)
  84.     (setq more t slen)
  85.     (setq slen (length str))
  86.     (if (equal 0 slen) ; test for a zero length string
  87.     nil
  88.     ; else
  89.         (progn
  90.       (setq string-is-nil nil)
  91.       (setq fm (string-match regexp str sindex)) ; start of match
  92.       (if (or (not fm) (< sindex fm)) (setq more nil)) ; found non-regexp
  93. ;      (debug nil "Before while" fm sindex)
  94.       (while more
  95.         (progn
  96.           (setq sindex (match-end 0))
  97.           (if (>= sindex slen) 
  98.           (progn
  99.             (setq string-is-nil t)
  100.             (setq more nil)
  101.             )
  102.         ;else
  103.         (progn
  104.           (setq fm (string-match regexp str sindex))
  105.           (if (or (not fm) (< sindex fm)) (setq more nil))
  106. ;          (debug nil "In while " fm sindex)
  107.         ); progn
  108.         ); if
  109.         ); progn
  110.       ); while
  111.       (if string-is-nil nil sindex)
  112.      ); progn
  113.     ); if
  114.   ) ; let
  115. ) ; first-not-regexp
  116.  
  117.  
  118.  
  119.  
  120. ; example hook usage
  121. ;
  122. ; (setq tst-equ-line-hook 'first-5)
  123. ; (setq tst-equ-mark-hook 'great-mark)
  124. ;
  125. ; example line hook - only compares first 5 chars on a line
  126. ;(defun first-5 ()
  127. ;    (string-equal (substring tst-equ-line1 0 5) (substring tst-equ-line2 0 5))
  128. ;)
  129.  
  130. ;example mark hook - only concerned with relative order of marks
  131. ;(defun great-mark ()
  132. ;    (> tst-equ-mark1 tst-equ-mark2)
  133. ; )
  134.  
  135.  
  136.  
  137.