original-message.txt - clic - Clic is an command line interactive client for gopher written in Common LISP
 (HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
 (DIR) Log
 (DIR) Files
 (DIR) Refs
 (DIR) Tags
 (DIR) README
 (DIR) LICENSE
       ---
       original-message.txt (4492B)
       ---
            1 From ...
            2 Path: supernews.google.com!sn-xit-02!sn-xit-03!supernews.com!news.tele.dk!193.190.198.17!newsfeeds.belnet.be!
            3 news.belnet.be!skynet.be!newsfeed2.news.nl.uu.net!sun4nl!not-for-mail
            4 From: Arthur Lemmens <lemmens@simplex.nl>
            5 Newsgroups: comp.lang.lisp
            6 Subject: Re: Q: on hashes and counting
            7 Date: Mon, 23 Oct 2000 00:50:02 +0200
            8 Organization: Kikashi Software
            9 Lines: 129
           10 Message-ID: <39F36F1A.B8F19D20@simplex.nl>
           11 References: <8sl58e$ivq$1@nnrp1.deja.com> <878zrlp1cr.fsf@orion.bln.pmsf.de>
           12 Mime-Version: 1.0
           13 Content-Type: text/plain; charset=us-ascii
           14 Content-Transfer-Encoding: 7bit
           15 X-Trace: porthos.nl.uu.net 972255051 2606 193.78.46.221 (22 Oct 2000 22:50:51 GMT)
           16 X-Complaints-To: abuse@nl.uu.net
           17 NNTP-Posting-Date: 22 Oct 2000 22:50:51 GMT
           18 X-Mailer: Mozilla 4.5 [en] (Win98; I)
           19 X-Accept-Language: en
           20 Xref: supernews.google.com comp.lang.lisp:2515
           21 
           22 
           23 Pierre R. Mai wrote:
           24 
           25 > ;;; The following functions are based on the versions by Arthur
           26 > ;;; Lemmens of the original code by Bernard Pfahringer posted to
           27 > ;;; comp.lang.lisp.  I only renamed and diddled them a bit.
           28 >
           29 > (defun partition
           30 
           31 [snip]
           32 
           33 >    ;; DO: Find a more efficient way to take care of :from-end T.
           34 >     (when from-end
           35 >       (setf seq (reverse seq))
           36 >       (psetf start (- len end)
           37 >              end   (- len start)))
           38 
           39 I've written a different version now for dealing with :FROM-END T.
           40 It doesn't call REVERSE anymore, which makes it more efficient.
           41 Also, I prefer the new semantics. Stuff like
           42   (split #\space "one   two three  "  :from-end t)
           43 now returns
           44   ("three" "two" "one")
           45 which I find a lot more useful than
           46   ("eerht" "owt" "eno")
           47 If you prefer the latter, it's easy enough to use
           48   (split #\space (reverse "one   two three  "))
           49 
           50 
           51 Here it is (feel free to use this code any way you like):
           52 
           53 (defun SPLIT (delimiter seq
           54                    &key (maximum nil)
           55                         (keep-empty-subseqs nil)
           56                         (from-end nil)
           57                         (start 0)
           58                         (end nil)
           59                         (test nil test-supplied)
           60                         (test-not nil test-not-supplied)
           61                         (key nil key-supplied))
           62 
           63 "Return a list of subsequences in <seq> delimited by <delimiter>.
           64 If :keep-empty-subseqs is true, empty subsequences will be included
           65 in the result; otherwise they will be discarded.
           66 If :maximum is supplied, the result will contain no more than :maximum
           67 (possibly empty) subsequences. The second result value contains the
           68 unsplit rest of the sequence.
           69 All other keywords work analogously to those for CL:POSITION."
           70 
           71 ;; DO: Make ":keep-delimiters t" include the delimiters in the result (?).
           72 
           73   (let ((len (length seq))
           74     (other-keys (nconc (when test-supplied
           75                          (list :test test))
           76                        (when test-not-supplied
           77                          (list :test-not test-not))
           78                        (when key-supplied
           79                          (list :key key)))))
           80 
           81 (unless end (setq end len))
           82 (if from-end
           83     (loop for right = end then left
           84           for left = (max (or (apply #'position delimiter seq
           85                                      :end right
           86                                      :from-end t
           87                                      other-keys)
           88                               -1)
           89                           (1- start))
           90           unless (and (= right (1+ left) )
           91                       (not keep-empty-subseqs)) ; empty subseq we don't want
           92           if (and maximum (>= nr-elts maximum))
           93           ;; We can't take any more. Return now.
           94           return (values subseqs (subseq seq start right))
           95           else
           96           collect (subseq seq (1+ left) right) into subseqs
           97           and sum 1 into nr-elts
           98           until (<= left start)
           99           finally return (values subseqs (subseq seq start (1+ left))))
          100   (loop for left = start then (+ right 1)
          101         for right = (min (or (apply #'position delimiter seq
          102                                     :start left
          103                                     other-keys)
          104                              len)
          105                          end)
          106         unless (and (= right left)
          107                     (not keep-empty-subseqs)) ; empty subseq we don't want
          108         if (and maximum (>= nr-elts maximum))
          109         ;; We can't take any more. Return now.
          110         return (values subseqs (subseq seq left end))
          111         else
          112         collect (subseq seq left right) into subseqs
          113         and sum 1 into nr-elts
          114         until (= right end)
          115         finally return (values subseqs (subseq seq right end))))))
          116 
          117 
          118 
          119 Here are some examples of how you can use this:
          120 
          121 
          122 CL-USER 2 > (split #\space "word1   word2 word3")
          123 ("word1" "word2" "word3")
          124 ""
          125 
          126 CL-USER 3 > (split #\space "word1   word2 word3" :from-end t)
          127 ("word3" "word2" "word1")
          128 ""
          129 
          130 CL-USER 4 > (split nil '(a b nil c d e nil nil nil nil f) :maximum 2)
          131 ((A B) (C D E))
          132 (F)
          133 
          134 CL-USER 5 > (split #\space "Nospaceshere.")
          135 ("Nospaceshere.")
          136 ""
          137 
          138 CL-USER 6 > (split #\; "12;13;;14" :keep-empty-subseqs t)
          139 
          140 ("12" "13" "" "14")
          141 ""
          142 
          143 CL-USER 7 > (split #\; "12;13;;14" :keep-empty-subseqs t :from-end t)
          144 
          145 ("14" "" "13" "12")
          146 ""
          147 
          148 CL-USER 8 > (split #\space "Nospaceshere.    ")
          149 ("Nospaceshere.")
          150 ""