Eliminate remaining uses of list-search-positive.

diff --git a/src/compiler/back/mermap.scm b/src/compiler/back/mermap.scm
index 289b7bc6f8169963ebdd83e198b717312778bc7d..73c6ff37195b2bdf9653862fd7beed9217bb9e5d 100644 (file)
--- a/src/compiler/back/mermap.scm
+++ b/src/compiler/back/mermap.scm
@@ -66,9 +66,9 @@ USA.
              (let ((homes (cdr conflicting-alias)))
                (let ((maximum (apply max (map cdr homes))))
                  (let ((winner
-                        (list-search-positive homes
-                          (lambda (home)
-                            (= (cdr home) maximum)))))
+                        (find (lambda (home)
+                                (= (cdr home) maximum))
+                              homes)))
                    (for-each
                     (lambda (home)
                       (if (not (eq? home winner))
@@ -111,10 +111,10 @@ USA.
 (define (add-weighted-entries x-entries y-entries)
   (merge-entries x-entries y-entries
     (lambda (entry entries)
-      (list-search-positive entries
-       (let ((home (vector-ref entry 0)))
-         (lambda (entry)
-           (eqv? home (vector-ref entry 0))))))
+      (find (let ((home (vector-ref entry 0)))
+             (lambda (entry)
+               (eqv? home (vector-ref entry 0))))
+           entries))
     (lambda (x-entry y-entry)
       (vector (vector-ref x-entry 0)
              (min (vector-ref x-entry 1) (vector-ref y-entry 1))

diff --git a/src/compiler/back/regmap.scm b/src/compiler/back/regmap.scm
index c4e8693f7dbd652dea8c38c80340b09307604361..479f7a7040346b452fc4bfcda7f2f4e8b12e41c5 100644 (file)
--- a/src/compiler/back/regmap.scm
+++ b/src/compiler/back/regmap.scm
@@ -188,10 +188,10 @@ registers into some interesting sorting order.
   (car (map-entry-aliases entry)))
 
 (define (map-entry:find-alias entry type needed-registers)
-  (list-search-positive (map-entry-aliases entry)
-    (lambda (alias)
-      (and (register-type? alias type)
-          (not (memv alias needed-registers))))))
+  (find (lambda (alias)
+         (and (register-type? alias type)
+              (not (memv alias needed-registers))))
+       (map-entry-aliases entry)))
 
 (define (map-entry:aliases entry type needed-registers)
   (filter (lambda (alias)
@@ -346,10 +346,10 @@ registers into some interesting sorting order.
          (else
           (and (not (null? y-entries))
                (let ((y-entry
-                      (list-search-positive y-entries
-                        (let ((home (map-entry-home (car x-entries))))
-                          (lambda (entry)
-                            (eqv? (map-entry-home entry) home))))))
+                      (find (let ((home (map-entry-home (car x-entries))))
+                              (lambda (entry)
+                                (eqv? (map-entry-home entry) home)))
+                            y-entries)))
                  (and y-entry
                       (boolean=? (map-entry-saved-into-home? (car x-entries))
                                  (map-entry-saved-into-home? y-entry))
@@ -428,10 +428,10 @@ registers into some interesting sorting order.
                             (LAP)))))
   ;; First see if there is an unused register of the given type.
   (or (let ((register
-            (list-search-positive (map-registers map)
-              (lambda (alias)
-                (and (register-type? alias type)
-                     (not (memv alias needed-registers)))))))
+            (find (lambda (alias)
+                    (and (register-type? alias type)
+                         (not (memv alias needed-registers))))
+                  (map-registers map))))
        (and register (allocator-values register map (LAP))))
       ;; There are no free registers available, so must reallocate
       ;; one.  First look for a temporary register that is no longer
@@ -480,10 +480,10 @@ registers into some interesting sorting order.
 (define (allocate-register-without-unload? map type needed-registers)
   ;; True iff a register of `type' can be allocated without displacing
   ;; any pseudo-registers from the register map.
-  (or (list-search-positive (map-registers map)
-       (lambda (alias)
-         (and (register-type? alias type)
-              (not (memv alias needed-registers)))))
+  (or (find (lambda (alias)
+             (and (register-type? alias type)
+                  (not (memv alias needed-registers))))
+           (map-registers map))
       (map-entries:search map
        (lambda (entry)
          (and (map-entry:find-alias entry type needed-registers)
@@ -497,8 +497,8 @@ registers into some interesting sorting order.
   ;; contents into that register.
   (or (let ((entry (map-entries:find-home map home)))
        (and entry
-            (let ((alias (list-search-positive (map-entry-aliases entry)
-                           (register-type-predicate type))))
+            (let ((alias (find (register-type-predicate type)
+                               (map-entry-aliases entry))))
               (and alias
                    (allocator-values alias map (LAP))))))
       (bind-allocator-values (make-free-register map type needed-registers)
@@ -556,18 +556,18 @@ registers into some interesting sorting order.
 the same value as REGISTER.  If no such register exists, returns #F."
   (let ((entry (map-entries:find-alias map register)))
     (and entry
-        (list-search-positive (map-entry-aliases entry)
-          (lambda (register*)
-            (and (not (eq? register register*))
-                 (register-type? type register*)))))))
+        (find (lambda (register*)
+                (and (not (eq? register register*))
+                     (register-type? type register*)))
+              (map-entry-aliases entry)))))
 
 (define (pseudo-register-alias map type register)
   "Returns a machine register, of the given TYPE, which is an alias
 for REGISTER.  If no such register exists, returns #F."
   (let ((entry (map-entries:find-home map register)))
     (and entry
-        (list-search-positive (map-entry-aliases entry)
-          (register-type-predicate type)))))
+        (find (register-type-predicate type)
+              (map-entry-aliases entry)))))
 
 (define (machine-register-is-unique? map register)
   "True if REGISTER has no other aliases."
@@ -585,9 +585,9 @@ for REGISTER.  If no such register exists, returns #F."
 (define (is-pseudo-register-alias? map maybe-alias register)
   (let ((entry (map-entries:find-home map register)))
     (and entry
-        (list-search-positive (map-entry-aliases entry)
-          (lambda (alias)
-            (eqv? maybe-alias alias))))))
+        (find (lambda (alias)
+                (eqv? maybe-alias alias))
+              (map-entry-aliases entry)))))
 
 (define (save-machine-register map register receiver)
   (let ((entry (map-entries:find-alias map register)))

diff --git a/src/compiler/base/constr.scm b/src/compiler/base/constr.scm
index 3f3aeca72b15049e5baab56637855791ccd6de0b..d1ace07505e34af8369f30fa6538190dc53c9e0e 100644 (file)
--- a/src/compiler/base/constr.scm
+++ b/src/compiler/base/constr.scm
@@ -71,7 +71,7 @@ USA.
     (if (eqv? element (constraint/element constraint))
        constraint
        (loop (constraint/afters constraint))))
-  
+
   (loop (constraint-graph/entry-nodes graph-head)))
 
 (define (find-or-make-constraint element graph-head
@@ -80,7 +80,7 @@ USA.
       (if (default-object? afters)
          (make-constraint element graph-head)
          (make-constraint element graph-head afters))))
-          
+
 \f
 (define (constraint-add! before after)
   (if (eq? (constraint/element before) (constraint/element after))
@@ -88,7 +88,7 @@ USA.
   (set-constraint/afters! before (cons after (constraint/afters before)))
   (let ((c-graph (constraint/graph-head after)))
     (if c-graph
-       (set-constraint-graph/entry-nodes! 
+       (set-constraint-graph/entry-nodes!
         c-graph
         (delq! after (constraint-graph/entry-nodes c-graph)))))
   (set-constraint/closed?! before false)
@@ -178,13 +178,11 @@ USA.
             (result '()))
     (if (and (pair? linearized-constraints)
             (pair? things))
-       (let ((match (list-search-positive
-                        things
-                      (lambda (thing)
-                        (eqv?
-                         (constraint/element
-                          (car linearized-constraints))
-                         (element-extractor thing))))))
+       (let ((match
+              (find (lambda (thing)
+                      (eqv? (constraint/element (car linearized-constraints))
+                            (element-extractor thing)))
+                    things)))
          (loop (cdr linearized-constraints)
                (delv match things)
                (if (and match
@@ -223,7 +221,7 @@ USA.
                           node-marked?)
 
   (define result)
-  
+
   (define (loop node)
     (node-mark! node)
     (for-each next (get-children node))
@@ -233,7 +231,7 @@ USA.
     (and node
         (not (node-marked? node))
         (loop node)))
-    
+
   (define (doit node)
     (set! result '())
     (loop node)
@@ -261,4 +259,3 @@ USA.
 
 (define (constraint-mark! constraint)
   (set-constraint/generation! constraint *constraint-generation*))
-

diff --git a/src/compiler/fgopt/blktyp.scm b/src/compiler/fgopt/blktyp.scm
index 3d97213c6f7c859c7dab9fee768a6f5c5b9f9f97..92e6a9cc034811625512c86107a89f76ff43f385 100644 (file)
--- a/src/compiler/fgopt/blktyp.scm
+++ b/src/compiler/fgopt/blktyp.scm
@@ -265,9 +265,9 @@ USA.
 (define (merge-children! block procedure unconditional conditional update?)
   (let ((ic-parent
         (let ((block
-               (list-search-positive unconditional
-                 (lambda (block*)
-                   (block-parent (block-parent block*))))))
+               (find (lambda (block*)
+                       (block-parent (block-parent block*)))
+                     unconditional)))
           (and block
                (block-parent (block-parent block)))))
        (closed-over-variables

diff --git a/src/compiler/fgopt/reteqv.scm b/src/compiler/fgopt/reteqv.scm
index 0fe8830d2a197d9b710cef6d7465efadcadb3cfb..4559606d72b3fcd3aa233cbf586cca5fbf4837d3 100644 (file)
--- a/src/compiler/fgopt/reteqv.scm
+++ b/src/compiler/fgopt/reteqv.scm
@@ -74,9 +74,9 @@ USA.
                       (begin
                         (node-mark! node)
                         (let ((class
-                               (list-search-positive classes
-                                 (lambda (class)
-                                   (node=? node (car class))))))
+                               (find (lambda (class)
+                                       (node=? node (car class)))
+                                     classes)))
                           (if class
                               (set-cdr! class (cons node (cdr class)))
                               (begin

diff --git a/src/compiler/machines/C/lapgen.scm b/src/compiler/machines/C/lapgen.scm
index f9a227180b9c76a260da6f3c8081db8f9bc4438c..92548e98f5dda062f31b49252fea801674e5d220 100644 (file)
--- a/src/compiler/machines/C/lapgen.scm
+++ b/src/compiler/machines/C/lapgen.scm
@@ -396,9 +396,9 @@ USA.
 
 (define (object-label-value label)
   (let ((entry
-        (list-search-positive (table->list-of-entries objects)
-          (lambda (entry)
-            (string=? label (entry-label entry))))))
+        (find (lambda (entry)
+                (string=? label (entry-label entry)))
+              (table->list-of-entries objects))))
     (if (not entry)
        (error "object-label-value: Unknown" label)
        (entry-value entry))))

diff --git a/src/compiler/rtlopt/rtlcsm.scm b/src/compiler/rtlopt/rtlcsm.scm
index 755d6c8a066f3ea893415fd8062588b63a62a90f..cfbdb7174cd77662012c4553cba5477151e89b1b 100644 (file)
--- a/src/compiler/rtlopt/rtlcsm.scm
+++ b/src/compiler/rtlopt/rtlcsm.scm
@@ -134,22 +134,22 @@ USA.
   (let ((classes '())
        (class-member?
         (lambda (class suffix)
-          (list-search-positive class
-            (lambda (suffix*)
-              (and (eq? (car suffix) (car suffix*))
-                   (eq? (cdr suffix) (cdr suffix*))))))))
+          (find (lambda (suffix*)
+                  (and (eq? (car suffix) (car suffix*))
+                       (eq? (cdr suffix) (cdr suffix*))))
+                class))))
     (for-each (lambda (entry)
                (let ((class
-                      (list-search-positive classes
-                        (lambda (class)
-                          (class-member? class (car entry))))))
+                      (find (lambda (class)
+                              (class-member? class (car entry)))
+                            classes)))
                  (if class
                      (if (not (class-member? class (cdr entry)))
                          (set-cdr! class (cons (cdr entry) (cdr class))))
                      (let ((class
-                            (list-search-positive classes
-                              (lambda (class)
-                                (class-member? class (cdr entry))))))
+                            (find (lambda (class)
+                                    (class-member? class (cdr entry)))
+                                  classes)))
                        (if class
                            (set-cdr! class (cons (car entry) (cdr class)))
                            (set! classes

diff --git a/src/cref/redpkg.scm b/src/cref/redpkg.scm
index 75dd00152caf03ee46d7932c6b058310172b2085..632d9b951578368c52f2c5cd9d1357246803dfda 100644 (file)
--- a/src/cref/redpkg.scm
+++ b/src/cref/redpkg.scm
@@ -614,9 +614,9 @@ USA.
             (package-loop (package/parent package))))))
 
 (define (name->package packages name)
-  (list-search-positive packages
-    (lambda (package)
-      (symbol-list=? name (package/name package)))))
+  (find (lambda (package)
+         (symbol-list=? name (package/name package)))
+       packages))
 
 (define (process-package-description package description get-package)
   (let ((file-cases (package-description/file-cases description)))

diff --git a/src/edwin/artdebug.scm b/src/edwin/artdebug.scm
index dfa4e5a379e41ef1b3c0f3d7063e17d20ec17ba5..56d947357adb917634f54ebce77868e2742c5d2e 100644 (file)
--- a/src/edwin/artdebug.scm
+++ b/src/edwin/artdebug.scm
@@ -889,9 +889,9 @@ Prefix argument means do not kill the debugger buffer."
 
 (define (continuation-browser-abort restarts)
   (let ((restart
-        (list-search-positive restarts
-          (lambda (restart)
-            (eq? (restart/name restart) 'abort)))))
+        (find (lambda (restart)
+                (eq? (restart/name restart) 'abort))
+              restarts)))
     (if (not restart)
        (editor-error "Can't find an abort restart")
        (fluid-let ((hook/invoke-restart

diff --git a/src/edwin/calias.scm b/src/edwin/calias.scm
index a19eac61e7ab15bb79ac6ad1a472da0aa8d8527f..ec0e3570134ee27d0f71665fc405fa6dc54bc514 100644 (file)
--- a/src/edwin/calias.scm
+++ b/src/edwin/calias.scm
@@ -73,9 +73,9 @@ USA.
                    (+ code (if (<= #x01 code #x1A) #x60 #x40)))
                  (fix:or (char-bits key) char-bit:control)))
       (let ((entry
-            (list-search-positive alias-keys
-              (lambda (entry)
-                (eqv? (cdr entry) key)))))
+            (find (lambda (entry)
+                    (eqv? (cdr entry) key))
+                  alias-keys)))
        (if entry
            (unmap-alias-key (car entry))
            key))))

diff --git a/src/edwin/debug.scm b/src/edwin/debug.scm
index 1772b847fdbbb90ad24b99c68830de42947adc85..fc8d1e7deff9400f825f9199d7dac1a945e28e30 100644 (file)
--- a/src/edwin/debug.scm
+++ b/src/edwin/debug.scm
@@ -512,10 +512,10 @@ USA.
   (let ((environment (bline/evaluation-environment bline)))
     (bline/attached-buffer bline 'ENVIRONMENT-BROWSER
       (lambda ()
-       (or (list-search-positive (buffer-list)
-             (lambda (buffer)
-               (let ((browser (buffer-get buffer 'BROWSER)))
-                 (and browser (eq? environment (browser/object browser))))))
+       (or (find (lambda (buffer)
+                   (let ((browser (buffer-get buffer 'BROWSER)))
+                     (and browser (eq? environment (browser/object browser)))))
+                 (buffer-list))
            (environment-browser-buffer environment))))))
 
 (define (bline/attached-buffer bline type make-buffer)

diff --git a/src/edwin/dired.scm b/src/edwin/dired.scm
index bb37c5b080487b26b0e6d3a0a926434891adcc01..4a1d4877deaff264f85007862bbb68fbe1fb6b07 100644 (file)
--- a/src/edwin/dired.scm
+++ b/src/edwin/dired.scm
@@ -158,9 +158,9 @@ Type `h' after entering dired for more info."
            buffer)))))
 
 (define (find-dired-buffer directory-spec)
-  (list-search-positive (buffer-list)
-    (lambda (buffer)
-      (equal? directory-spec (buffer-get buffer 'DIRED-DIRECTORY-SPEC)))))
+  (find (lambda (buffer)
+         (equal? directory-spec (buffer-get buffer 'DIRED-DIRECTORY-SPEC)))
+       (buffer-list)))
 
 (define (dired-buffer-directory-spec buffer)
   (or (buffer-get buffer 'DIRED-DIRECTORY-SPEC)

diff --git a/src/edwin/display.scm b/src/edwin/display.scm
index d3d95ca1a94def45a66b319f9818fdc1878da3b5..a6cd0556a336365c8c350fc19d2dc30c4af5d673 100644 (file)
--- a/src/edwin/display.scm
+++ b/src/edwin/display.scm
@@ -90,7 +90,7 @@ USA.
 
 (define (name->display-type name)
   (let ((display-type
-        (list-search-positive display-types
-          (lambda (display-type)
-            (eq? name (display-type/name display-type))))))
+        (find (lambda (display-type)
+                (eq? name (display-type/name display-type)))
+              display-types)))
     display-type))
\ No newline at end of file

diff --git a/src/edwin/filcom.scm b/src/edwin/filcom.scm
index c385f85e6670d63b7772bbaf8933e54e75f69ee1..6da61accf3380227a18f1d6abd5367abd716f304 100644 (file)
--- a/src/edwin/filcom.scm
+++ b/src/edwin/filcom.scm
@@ -479,9 +479,9 @@ all buffers."
 
 (define (pathname->buffer pathname)
   (let ((pathname (->pathname pathname)))
-    (list-search-positive (buffer-list)
-      (lambda (buffer)
-       (equal? pathname (buffer-pathname buffer))))))
+    (find (lambda (buffer)
+           (equal? pathname (buffer-pathname buffer)))
+         (buffer-list))))
 \f
 (define-command set-visited-file-name
   "Change name of file visited in current buffer.

diff --git a/src/edwin/info.scm b/src/edwin/info.scm
index 0b7c04fe2d0443b9ef431009cee283ccf88016da..36802a909e00d263c1079d93204e3a3a5d2b1500 100644 (file)
--- a/src/edwin/info.scm
+++ b/src/edwin/info.scm
@@ -457,9 +457,9 @@ except for \\[info-cease-edit] to return to Info."
                  (let ((current-item (current-menu-item (current-point))))
                    (and current-item
                         (let ((current-index (mark-index current-item)))
-                          (list-search-positive item-alist
-                            (lambda (entry)
-                              (= current-index (cdr entry)))))))))
+                          (find (lambda (entry)
+                                  (= current-index (cdr entry)))
+                                item-alist))))))
             (if current-entry
                 (prompt-for-alist-value "Menu item"
                                         item-alist
@@ -858,9 +858,9 @@ The name may be an abbreviation of the reference name."
       (for-each
        (lambda (submenu)
         (let ((nodename (car submenu)))
-          (if (not (or (list-search-positive menu-items
-                         (lambda (item)
-                           (string-ci=? item nodename)))
+          (if (not (or (find (lambda (item)
+                               (string-ci=? item nodename))
+                             menu-items)
                        (re-search-forward (string-append "^\\* "
                                                          (re-quote-string
                                                           nodename)

diff --git a/src/edwin/keymap.scm b/src/edwin/keymap.scm
index 793fa8aac13771af7ce6e5e783d84b8e2bae5e87..a71e8df2e31c8189e668fca3e1572bb5d4d35e2d 100644 (file)
--- a/src/edwin/keymap.scm
+++ b/src/edwin/keymap.scm
@@ -162,9 +162,9 @@ Previous contents of that buffer are killed first."
     (let ((make-entry
           (lambda (prefix element)
             (let ((entry
-                   (list-search-positive prefix-alist
-                     (lambda (entry)
-                       (string=? (car entry) prefix)))))
+                   (find (lambda (entry)
+                           (string=? (car entry) prefix))
+                         prefix-alist)))
               (if entry
                   (set-cdr! entry (cons element (cdr entry)))
                   (set! prefix-alist

diff --git a/src/edwin/snr.scm b/src/edwin/snr.scm
index 4b30027cf4c5b013555318f6958deb7263220375..a7d90bcaa691999dcbae9593dbb67c34989a1d07 100644 (file)
--- a/src/edwin/snr.scm
+++ b/src/edwin/snr.scm
@@ -398,10 +398,10 @@ Only one News reader may be open per server; if a previous News reader
 ;;;; News-Server Buffer
 
 (define (find-news-server-buffer server)
-  (list-search-positive (buffer-list)
-    (lambda (buffer)
-      (and (news-server-buffer? buffer)
-          (string-ci=? (news-server-buffer:server buffer) server)))))
+  (find (lambda (buffer)
+         (and (news-server-buffer? buffer)
+              (string-ci=? (news-server-buffer:server buffer) server)))
+       (buffer-list)))
 
 (define (make-news-server-buffer server)
   (create-news-buffer (news-buffer-name server "subscribed-groups")

diff --git a/src/edwin/unix.scm b/src/edwin/unix.scm
index b4841b8f9291ad44cca96b5f5eb7328f2e73e6e8..93521f946002cf917aec530b9bc3f2a4965e388d 100644 (file)
--- a/src/edwin/unix.scm
+++ b/src/edwin/unix.scm
@@ -657,9 +657,8 @@ option, instead taking -P <filename>."
   set-file-modes!)
 
 (define (os/rmail-spool-directory)
-  (or (list-search-positive
-         '("/var/spool/mail/" "/var/mail/" "/usr/spool/mail/" "/usr/mail/")
-       file-directory?)
+  (or (find file-directory?
+           '("/var/spool/mail/" "/var/mail/" "/usr/spool/mail/" "/usr/mail/"))
       "/usr/spool/mail/"))
 
 (define (os/rmail-primary-inbox-list system-mailboxes)

diff --git a/src/edwin/vc.scm b/src/edwin/vc.scm
index 9ba33570665455bf4fef6ae7e0df38b57eb1a2fd..2eaa5e1709348f853f821077518b1ce0ac24fff9 100644 (file)
--- a/src/edwin/vc.scm
+++ b/src/edwin/vc.scm
@@ -921,11 +921,11 @@ Normally shows only locked files; prefix arg says to show all files."
     buffer))
 
 (define (get-vc-dired-buffer directory)
-  (or (list-search-positive (buffer-list)
-       (lambda (buffer)
-         (let ((spec (buffer-get buffer 'VC-DIRECTORY-SPEC #f)))
-           (and spec
-                (pathname=? (car spec) directory)))))
+  (or (find (lambda (buffer)
+             (let ((spec (buffer-get buffer 'VC-DIRECTORY-SPEC #f)))
+               (and spec
+                    (pathname=? (car spec) directory))))
+           (buffer-list))
       (new-buffer (pathname->buffer-name directory))))
 
 (define (fill-vc-dired-buffer! buffer directory all-files?)

diff --git a/src/edwin/win32.scm b/src/edwin/win32.scm
index b84c76eb8846a0c68905e0ccd82bcd5a6e440865..8cf5ddce025c4651a9cd6be4f5c35034d5c87a39 100644 (file)
--- a/src/edwin/win32.scm
+++ b/src/edwin/win32.scm
@@ -247,8 +247,8 @@ USA.
       (error "Screen has unexpectedly vanished" screen)))
 
 (define (handle->win32-screen handle)
-  (list-search-positive win32-screens
-    (lambda (screen) (eqv? handle (state/handle (screen-state screen))))))
+  (find (lambda (screen) (eqv? handle (state/handle (screen-state screen))))
+       win32-screens))
 \f
 (define-integrable (screen-name screen)
   (state/name (screen-state screen)))

diff --git a/src/imail/imail-browser.scm b/src/imail/imail-browser.scm
index 964d30b5b60b1e7ff4ea250b89f01b2d5805a1a7..2a4c931f9a865434f91bb68fdfacbe03b343c9fa 100644 (file)
--- a/src/imail/imail-browser.scm
+++ b/src/imail/imail-browser.scm
@@ -32,9 +32,9 @@ USA.
   (select-buffer (get-imail-browser-buffer url)))
 
 (define (get-imail-browser-buffer url)
-  (or (list-search-positive (buffer-list)
-       (lambda (buffer)
-         (eq? (selected-container-url #f buffer) url)))
+  (or (find (lambda (buffer)
+             (eq? (selected-container-url #f buffer) url))
+           (buffer-list))
       (let ((container (open-resource url))
            (buffer
             (new-buffer

diff --git a/src/imail/imail-imap.scm b/src/imail/imail-imap.scm
index f3be5b2423bdcb3174e239ff081ef87db860a00c..d8acca172fc2f4ef9ff1248738b5bf959938d5dc 100644 (file)
--- a/src/imail/imail-imap.scm
+++ b/src/imail/imail-imap.scm
@@ -1161,9 +1161,9 @@ USA.
 
 (define (imail-flag->imap-flag flag)
   (let ((entry
-        (list-search-positive standard-imap-flags
-          (lambda (entry)
-            (string-ci=? flag (cdr entry))))))
+        (find (lambda (entry)
+                (string-ci=? flag (cdr entry)))
+              standard-imap-flags)))
     (if entry
        (car entry)
        (intern flag))))

diff --git a/src/imail/imail-top.scm b/src/imail/imail-top.scm
index 8afbfeb62941860166c57bfe993d5372ffb54d84..b7433c480ff835f8023b0707a8b0a71f1ff9e647 100644 (file)
--- a/src/imail/imail-top.scm
+++ b/src/imail/imail-top.scm
@@ -2073,9 +2073,9 @@ WARNING: With a prefix argument, this command may take a very long
       (and error? (error:bad-range-argument folder 'IMAIL-FOLDER->BUFFER))))
 
 (define (imail-message->buffer message error?)
-  (or (list-search-positive (buffer-list)
-       (lambda (buffer)
-         (eq? (buffer-get buffer 'IMAIL-MESSAGE #f) message)))
+  (or (find (lambda (buffer)
+             (eq? (buffer-get buffer 'IMAIL-MESSAGE #f) message))
+           (buffer-list))
       (and error? (error:bad-range-argument message 'IMAIL-MESSAGE->BUFFER))))
 
 (define (associate-buffer-with-imail-buffer folder-buffer buffer)

diff --git a/src/imail/imap-response.scm b/src/imail/imap-response.scm
index df690348a19c265237c46dd6772365102476becd..1de18222dc1268d77faad0e906478f4dbecbdacd 100644 (file)
--- a/src/imail/imap-response.scm
+++ b/src/imail/imap-response.scm
@@ -655,16 +655,16 @@ USA.
 
 (define (imap:response:fetch-body-part response section offset)
   (let ((entry
-        (list-search-positive (cddr response)
-          (lambda (entry)
-            (and (eq? (car entry) 'BODY)
-                 (equal? (cadr entry) section)
-                 (pair? (cddr entry))
-                 (eqv? offset (caddr entry))
-                 (pair? (cdddr entry))
-                 (or (not (cadddr entry))
-                     (string? (cadddr entry)))
-                 (null? (cddddr entry)))))))
+        (find (lambda (entry)
+                (and (eq? (car entry) 'BODY)
+                     (equal? (cadr entry) section)
+                     (pair? (cddr entry))
+                     (eqv? offset (caddr entry))
+                     (pair? (cdddr entry))
+                     (or (not (cadddr entry))
+                         (string? (cadddr entry)))
+                     (null? (cddddr entry))))
+              (cddr response))))
     (if (not entry)
        (error "Missing FETCH body part:" section offset))
     (cadddr entry)))

diff --git a/src/sos/class.scm b/src/sos/class.scm
index ed740dc7c31814ce160d69a09f9f0336434ee75a..52ae781ddf82cc2145e0e85df853c518c0c6da46 100644 (file)
--- a/src/sos/class.scm
+++ b/src/sos/class.scm
@@ -114,9 +114,9 @@ USA.
   (class/slots (guarantee-class class 'CLASS-SLOTS)))
 
 (define (class-slot class name error?)
-  (or (list-search-positive (class/slots (guarantee-class class 'CLASS-SLOT))
-       (lambda (slot)
-         (eq? name (slot-name slot))))
+  (or (find (lambda (slot)
+             (eq? name (slot-name slot)))
+           (class/slots (guarantee-class class 'CLASS-SLOT)))
       (and error?
           (class-slot class (error:no-such-slot class name) error?))))
 

diff --git a/src/sos/method.scm b/src/sos/method.scm
index 0a4a25bdba67d33cde99efd5721fc8d74ef616e0..7fe7a711d7b491e8613778c00d528ab87353cd52 100644 (file)
--- a/src/sos/method.scm
+++ b/src/sos/method.scm
@@ -105,8 +105,8 @@ USA.
 
 (define (method-combinator-record generic intern?)
   (let ((combinator
-        (or (list-search-positive (generic-procedure-generator-list generic)
-              method-combinator?)
+        (or (find method-combinator?
+                  (generic-procedure-generator-list generic))
             (and intern?
                  (let ((combinator (make-method-combinator)))
                    (add-generic-procedure-generator generic combinator)

diff --git a/src/sos/slot.scm b/src/sos/slot.scm
index 77a776d92863338e14f594efc07a2c1a6cc84ae9..474412796a25cd2ff5bf4b89db4acaaae362298f 100644 (file)
--- a/src/sos/slot.scm
+++ b/src/sos/slot.scm
@@ -183,9 +183,9 @@ USA.
         (for-each
          (lambda (x)
            (let ((names
-                  (or (list-search-positive interacting-options
-                        (lambda (names)
-                          (memq (car x) names)))
+                  (or (find (lambda (names)
+                              (memq (car x) names))
+                            interacting-options)
                       (list (car x)))))
              (let ((entry
                     (let loop ((names names))