compare-strings

[Daiki Ueno]

上野です。

自己満足にすぎないのですが、Emacs 20.3 から導入された compare-strings を
emulate してみました。実装は単純に C のソースに基づいています。

compare-buffer-substrings を使う方法もあるかと思いますが、恐らく労力は、
ほとんど変わらないのではないかと思うので...。

;; APEL に入れるとすると member-ignore-case や assoc-ignore-case の方が
;; 需要がありそうですが。

-------------- next part --------------
(defun-maybe compare-strings (str1 start1 end1 str2 start2 end2 &optional ignore-case)
  "Compare the contents of two strings, converting to multibyte if needed.
In string STR1, skip the first START1 characters and stop at END1.
In string STR2, skip the first START2 characters and stop at END2.
END1 and END2 default to the full lengths of the respective strings.

Case is significant in this comparison if IGNORE-CASE is nil.
Unibyte strings are converted to multibyte for comparison.

The value is t if the strings (or specified portions) match.
If string STR1 is less, the value is a negative number N;
  - 1 - N is the number of characters that match at the beginning.
If string STR1 is greater, the value is a positive number N;
  N - 1 is the number of characters that match at the beginning."
  (or end1
      (setq end1 (length str1)))
  (or end2
      (setq end2 (length str2)))
  (let ((start_char 0) (i 0) chr c1 c2)
    (while (< i start1)
      (setq chr (sref str1 i))
      (setq start_char (1+ start_char))
      (setq i (+ i (char-bytes chr))))
    (setq i start_char)
    (catch 'found
      (while (and (< start1 end1) (< start2 end2))
	(setq c1 (sref str1 start1)
	      c2 (sref str2 start2)
	      i (1+ i))
	(let ((case-fold-search ignore-case)
	      (nonascii-insert-offset 0))
	  (unless (char-equal c1 c2)
	    (if ignore-case
		(setq c1 (upcase c1)
		      c2 (upcase c2)))
	    (if (< c1 c2)
		(throw 'found (- i))
	      (throw 'found i))))
	(setq start1 (+ start1 (char-bytes c1)))
	(setq start2 (+ start2 (char-bytes c2))))
      (if (> start1 end1)
	  (- i start_char -1)
	(if (> start2 end2)
	    (- start_char i 1)
	  t)))))

-------------- next part --------------
-- 
Daiki Ueno