Changeset 16132


Ignore:
Timestamp:
Jul 22, 2014, 6:38:54 PM (7 years ago)
Author:
svspire
Message:

Get rid of bogus "Zero length search string not allowed" error
when you backspace out of an incremental search.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/hemlock/src/search1.lisp

    r13585 r16132  
    6464(defmacro define-search-kind (kind lambda-list documentation &body forms)
    6565  `(progn
    66      (push ,documentation *search-pattern-documentation*)
     66     (pushnew ,documentation *search-pattern-documentation* :test #'string-equal)
    6767     (setf (gethash ,kind *search-pattern-experts*)
    6868           #'(lambda ,lambda-list ,@forms))))
     
    450450  ":string-insensitive - Pattern is a string to do a case-insensitive
    451451  search for."
    452   (unless old (setq old (make-string-insensitive-search-pattern)))
    453   (setf (search-pattern-kind old) :string-insensitive
    454         (search-pattern-direction old) direction
    455         (search-pattern-pattern old) pattern)
    456   (let* ((folded-string (string-upcase pattern)))
    457     (declare (simple-string folded-string))
    458     (cond
    459      ((find #\newline folded-string)
    460       (make-insensitive-newline-pattern old folded-string)
    461       (setf (search-pattern-search-function old)
    462             (if (eq direction :forward)
    463                 #'insensitive-find-newline-once-forward-method
    464                 #'insensitive-find-newline-once-backward-method))
    465       (setf (search-pattern-reclaim-function old) #'identity))
    466      (t
    467       (case direction
    468         (:forward
    469          (setf (search-pattern-search-function old)
    470                #'insensitive-find-string-once-forward-method))
    471         (t
    472          (setf (search-pattern-search-function old)
    473                #'insensitive-find-string-once-backward-method)
    474          (setq folded-string (nreverse folded-string))))
    475       (let ((hashed-string (search-hash-string folded-string)))
    476         (setf (string-insensitive-hashed-string old) hashed-string
    477               (string-insensitive-folded-string old) folded-string)
    478         (setf (string-insensitive-jumps old)
    479               (compute-boyer-moore-jumps hashed-string #'svref))
    480         (setf (search-pattern-reclaim-function old)
    481               #'(lambda (p)
    482                   (dispose-search-vector (string-insensitive-jumps p))))))))
    483   old)
     452  (unless (zerop (length pattern))
     453    (unless old (setq old (make-string-insensitive-search-pattern)))
     454    (setf (search-pattern-kind old) :string-insensitive
     455          (search-pattern-direction old) direction
     456          (search-pattern-pattern old) pattern)
     457    (let* ((folded-string (string-upcase pattern)))
     458      (declare (simple-string folded-string))
     459      (cond
     460       ((find #\newline folded-string)
     461        (make-insensitive-newline-pattern old folded-string)
     462        (setf (search-pattern-search-function old)
     463              (if (eq direction :forward)
     464                  #'insensitive-find-newline-once-forward-method
     465                  #'insensitive-find-newline-once-backward-method))
     466        (setf (search-pattern-reclaim-function old) #'identity))
     467       (t
     468        (case direction
     469          (:forward
     470           (setf (search-pattern-search-function old)
     471                 #'insensitive-find-string-once-forward-method))
     472          (t
     473           (setf (search-pattern-search-function old)
     474                 #'insensitive-find-string-once-backward-method)
     475           (setq folded-string (nreverse folded-string))))
     476        (let ((hashed-string (search-hash-string folded-string)))
     477          (setf (string-insensitive-hashed-string old) hashed-string
     478                (string-insensitive-folded-string old) folded-string)
     479          (setf (string-insensitive-jumps old)
     480                (compute-boyer-moore-jumps hashed-string #'svref))
     481          (setf (search-pattern-reclaim-function old)
     482                #'(lambda (p)
     483                    (dispose-search-vector (string-insensitive-jumps p))))))))
     484    old))
    484485
    485486
     
    566567  ":string-sensitive - Pattern is a string to do a case-sensitive
    567568  search for."
    568   (unless old (setq old (make-string-sensitive-search-pattern)))
    569   (setf (search-pattern-kind old) :string-sensitive
    570         (search-pattern-direction old) direction
    571         (search-pattern-pattern old) pattern)
    572   (let* ((string (coerce pattern 'simple-vector)))
    573     (declare (simple-vector string))
    574     (cond
    575      ((find #\newline string)
    576       (make-sensitive-newline-pattern old string)
    577       (setf (search-pattern-search-function old)
    578             (if (eq direction :forward)
    579                 #'sensitive-find-newline-once-forward-method
    580                 #'sensitive-find-newline-once-backward-method))
    581       (setf (search-pattern-reclaim-function old) #'identity))
    582      (t
    583       (case direction
    584         (:forward
    585          (setf (search-pattern-search-function old)
    586                #'sensitive-find-string-once-forward-method))
    587         (t
    588          (setf (search-pattern-search-function old)
    589                #'sensitive-find-string-once-backward-method)
    590          (setq string (nreverse string))))
    591       (setf (string-sensitive-string old) string)
    592       (setf (string-sensitive-jumps old)
    593             (compute-boyer-moore-jumps
    594              string #'(lambda (v i) (char-code (svref v i)))))
    595       (setf (search-pattern-reclaim-function old)
    596             #'(lambda (p)
    597                 (dispose-search-vector (string-sensitive-jumps p)))))))
    598   old)
     569  (unless (zerop (length pattern))
     570    (unless old (setq old (make-string-sensitive-search-pattern)))
     571    (setf (search-pattern-kind old) :string-sensitive
     572          (search-pattern-direction old) direction
     573          (search-pattern-pattern old) pattern)
     574    (let* ((string (coerce pattern 'simple-vector)))
     575      (declare (simple-vector string))
     576      (cond
     577       ((find #\newline string)
     578        (make-sensitive-newline-pattern old string)
     579        (setf (search-pattern-search-function old)
     580              (if (eq direction :forward)
     581                  #'sensitive-find-newline-once-forward-method
     582                  #'sensitive-find-newline-once-backward-method))
     583        (setf (search-pattern-reclaim-function old) #'identity))
     584       (t
     585        (case direction
     586          (:forward
     587           (setf (search-pattern-search-function old)
     588                 #'sensitive-find-string-once-forward-method))
     589          (t
     590           (setf (search-pattern-search-function old)
     591                 #'sensitive-find-string-once-backward-method)
     592           (setq string (nreverse string))))
     593        (setf (string-sensitive-string old) string)
     594        (setf (string-sensitive-jumps old)
     595              (compute-boyer-moore-jumps
     596               string #'(lambda (v i) (char-code (svref v i)))))
     597        (setf (search-pattern-reclaim-function old)
     598              #'(lambda (p)
     599                  (dispose-search-vector (string-sensitive-jumps p)))))))
     600    old))
    599601
    600602
Note: See TracChangeset for help on using the changeset viewer.