Return to sort.el CVS log

Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp

Annotation of 43BSDReno/contrib/emacs-18.55/lisp/sort.el, revision 1.1

1.1     ! root        1: ;; Commands to sort text in an Emacs buffer.
        !             2: ;; Copyright (C) 1986, 1987 Free Software Foundation, Inc.
        !             3: 
        !             4: ;; This file is part of GNU Emacs.
        !             5: 
        !             6: ;; GNU Emacs is distributed in the hope that it will be useful,
        !             7: ;; but WITHOUT ANY WARRANTY.  No author or distributor
        !             8: ;; accepts responsibility to anyone for the consequences of using it
        !             9: ;; or for whether it serves any particular purpose or works at all,
        !            10: ;; unless he says so in writing.  Refer to the GNU Emacs General Public
        !            11: ;; License for full details.
        !            12: 
        !            13: ;; Everyone is granted permission to copy, modify and redistribute
        !            14: ;; GNU Emacs, but only under the conditions described in the
        !            15: ;; GNU Emacs General Public License.   A copy of this license is
        !            16: ;; supposed to have been given to you along with GNU Emacs so you
        !            17: ;; can know your rights and responsibilities.  It should be in a
        !            18: ;; file named COPYING.  Among other things, the copyright notice
        !            19: ;; and this notice must be preserved on all copies.
        !            20: 
        !            21: (provide 'sort)
        !            22: 
        !            23: ;; Original version of most of this contributed by Howie Kaye
        !            24: 
        !            25: (defun sort-subr (reverse nextrecfun endrecfun &optional startkeyfun endkeyfun)
        !            26:   "General text sorting routine to divide buffer into records and sort them.
        !            27: Arguments are REVERSE NEXTRECFUN ENDRECFUN &optional STARTKEYFUN ENDKEYFUN.
        !            28: 
        !            29: We consider this portion of the buffer to be divided into disjoint pieces
        !            30: called sort records.  A portion of each sort record (perhaps all of it)
        !            31: is designated as the sort key.  The records are rearranged in the buffer
        !            32: in order by their sort keys.  The records may or may not be contiguous.
        !            33: 
        !            34: Usually the records are rearranged in order of ascending sort key.
        !            35: If REVERSE is non-nil, they are rearranged in order of descending sort key.
        !            36: 
        !            37: The next four arguments are functions to be called to move point
        !            38: across a sort record.  They will be called many times from within sort-subr.
        !            39: 
        !            40: NEXTRECFUN is called with point at the end of the previous record.
        !            41: It moves point to the start of the next record.
        !            42: The first record is assumed to start at the position of point when sort-subr
        !            43: is called.
        !            44: 
        !            45: ENDRECFUN is is called with point within the record.
        !            46: It should move point to the end of the record.
        !            47: 
        !            48: STARTKEYFUN may moves from the start of the record to the start of the key.
        !            49: It may return either return a non-nil value to be used as the key, or
        !            50: else the key will be the substring between the values of point after
        !            51: STARTKEYFUNC and ENDKEYFUN are called.
        !            52: 
        !            53: ENDKEYFUN moves from the start of the sort key to the end of the sort key.
        !            54: ENDRECFUN may be nil if STARTKEYFUN returns a value or if it would be the
        !            55: same as ENDRECFUN."
        !            56:   (save-excursion
        !            57:     (message "Finding sort keys...")
        !            58:     (let* ((sort-lists (sort-build-lists nextrecfun endrecfun
        !            59:                                        startkeyfun endkeyfun))
        !            60:           (old (reverse sort-lists)))
        !            61:       (if (null sort-lists)
        !            62:          ()
        !            63:        (or reverse (setq sort-lists (nreverse sort-lists)))
        !            64:        (message "Sorting records...")
        !            65:        (setq sort-lists
        !            66:              (if (fboundp 'sortcar)
        !            67:                  (sortcar sort-lists
        !            68:                           (cond ((numberp (car (car sort-lists)))
        !            69:                                  '<)
        !            70:                                 ((consp (car (car sort-lists)))
        !            71:                                  'buffer-substring-lessp)
        !            72:                                 (t
        !            73:                                  'string<)))
        !            74:                  (sort sort-lists
        !            75:                        (cond ((numberp (car (car sort-lists)))
        !            76:                               (function
        !            77:                                (lambda (a b)
        !            78:                                  (< (car a) (car b)))))
        !            79:                              ((consp (car (car sort-lists)))
        !            80:                               (function
        !            81:                                (lambda (a b)
        !            82:                                  (buffer-substring-lessp (car a) (car b)))))
        !            83:                              (t
        !            84:                               (function
        !            85:                                (lambda (a b)
        !            86:                                  (string< (car a) (car b)))))))))
        !            87:        (if reverse (setq sort-lists (nreverse sort-lists)))
        !            88:        (message "Reordering buffer...")
        !            89:        (sort-reorder-buffer sort-lists old)))
        !            90:     (message "Reordering buffer... Done")))
        !            91: 
        !            92: ;; Parse buffer into records using the arguments as Lisp expressions;
        !            93: ;; return a list of records.  Each record looks like (KEY STARTPOS ENDPOS)
        !            94: ;; where KEY is the sort key (a number or string),
        !            95: ;; and STARTPOS and ENDPOS are the bounds of this record in the buffer.
        !            96: 
        !            97: ;; The records appear in the list lastmost first!
        !            98: 
        !            99: (defun sort-build-lists (nextrecfun endrecfun startkeyfun endkeyfun)
        !           100:   (let ((sort-lists ())
        !           101:        (start-rec nil)
        !           102:        done key)
        !           103:     ;; Loop over sort records.
        !           104:     ;(goto-char (point-min)) -- it is the caller's responsibility to
        !           105:     ;arrange this if necessary
        !           106:     (while (not (eobp))
        !           107:       (setq start-rec (point))         ;save record start
        !           108:       (setq done nil)
        !           109:       ;; Get key value, or move to start of key.
        !           110:       (setq key (catch 'key
        !           111:                  (or (and startkeyfun (funcall startkeyfun))
        !           112:                      ;; If key was not returned as value,
        !           113:                      ;; move to end of key and get key from the buffer.
        !           114:                      (let ((start (point)))
        !           115:                        (funcall (or endkeyfun
        !           116:                                     (prog1 endrecfun (setq done t))))
        !           117:                        (if (fboundp 'buffer-substring-lessp)
        !           118:                            (cons start (point))
        !           119:                          (buffer-substring start (point)))))))
        !           120:       ;; Move to end of this record (start of next one, or end of buffer).
        !           121:       (cond ((prog1 done (setq done nil)))
        !           122:            (endrecfun (funcall endrecfun))
        !           123:            (nextrecfun (funcall nextrecfun) (setq done t)))
        !           124:       (if key (setq sort-lists (cons
        !           125:                                 ;; consing optimization in case in which key
        !           126:                                 ;; is same as record.
        !           127:                                 (if (and (consp key)
        !           128:                                          (equal (car key) start-rec)
        !           129:                                          (equal (cdr key) (point)))
        !           130:                                     (cons key key)
        !           131:                                     (list key start-rec (point)))
        !           132:                                sort-lists)))
        !           133:       (and (not done) nextrecfun (funcall nextrecfun)))
        !           134:     sort-lists))
        !           135: 
        !           136: (defun sort-reorder-buffer (sort-lists old)
        !           137:   (let ((inhibit-quit t)
        !           138:        (last (point-min))
        !           139:        (min (point-min)) (max (point-max)))
        !           140:     (while sort-lists
        !           141:       (goto-char (point-max))
        !           142:       (insert-buffer-substring (current-buffer)
        !           143:                               last
        !           144:                               (nth 1 (car old)))
        !           145:       (goto-char (point-max))
        !           146:       (insert-buffer-substring (current-buffer)
        !           147:                               (nth 1 (car sort-lists))
        !           148:                               (nth 2 (car sort-lists)))
        !           149:       (setq last (nth 2 (car old))
        !           150:            sort-lists (cdr sort-lists)
        !           151:            old (cdr old)))
        !           152:     (goto-char (point-max))
        !           153:     (insert-buffer-substring (current-buffer)
        !           154:                             last
        !           155:                             max)
        !           156:     (delete-region min max)))  ;get rid of old version
        !           157: 
        !           158: (defun sort-lines (reverse beg end) 
        !           159:   "Sort lines in region alphabetically; argument means descending order.
        !           160: Called from a program, there are three arguments:
        !           161: REVERSE (non-nil means reverse order), BEG and END (region to sort)."
        !           162:   (interactive "P\nr")
        !           163:   (save-restriction
        !           164:     (narrow-to-region beg end)
        !           165:     (goto-char (point-min))
        !           166:     (sort-subr reverse 'forward-line 'end-of-line)))
        !           167: 
        !           168: (defun sort-paragraphs (reverse beg end)
        !           169:   "Sort paragraphs in region alphabetically; argument means descending order.
        !           170: Called from a program, there are three arguments:
        !           171: REVERSE (non-nil means reverse order), BEG and END (region to sort)."
        !           172:   (interactive "P\nr")
        !           173:   (save-restriction
        !           174:     (narrow-to-region beg end)
        !           175:     (goto-char (point-min))
        !           176:     (sort-subr reverse
        !           177:               (function (lambda () (skip-chars-forward "\n \t\f")))
        !           178:               'forward-paragraph)))
        !           179: 
        !           180: (defun sort-pages (reverse beg end)
        !           181:   "Sort pages in region alphabetically; argument means descending order.
        !           182: Called from a program, there are three arguments:
        !           183: REVERSE (non-nil means reverse order), BEG and END (region to sort)."
        !           184:   (interactive "P\nr")
        !           185:   (save-restriction
        !           186:     (narrow-to-region beg end)
        !           187:     (goto-char (point-min))
        !           188:     (sort-subr reverse
        !           189:               (function (lambda () (skip-chars-forward "\n")))
        !           190:               'forward-page)))
        !           191: 
        !           192: (defvar sort-fields-syntax-table nil)
        !           193: (if sort-fields-syntax-table nil
        !           194:   (let ((table (make-syntax-table))
        !           195:        (i 0))
        !           196:     (while (< i 256)
        !           197:       (modify-syntax-entry i "w" table)
        !           198:       (setq i (1+ i)))
        !           199:     (modify-syntax-entry ?\  " " table)
        !           200:     (modify-syntax-entry ?\t " " table)
        !           201:     (modify-syntax-entry ?\n " " table)
        !           202:     (setq sort-fields-syntax-table table)))
        !           203: 
        !           204: (defun sort-numeric-fields (field beg end)
        !           205:   "Sort lines in region numerically by the ARGth field of each line.
        !           206: Fields are separated by whitespace and numbered from 1 up.
        !           207: Specified field must contain a number in each line of the region.
        !           208: With a negative arg, sorts by the -ARG'th field, in reverse order.
        !           209: Called from a program, there are three arguments:
        !           210: FIELD, BEG and END.  BEG and END specify region to sort."
        !           211:   (interactive "p\nr")
        !           212:   (sort-fields-1 field beg end
        !           213:                 (function (lambda ()
        !           214:                             (sort-skip-fields (1- field))
        !           215:                             (string-to-int
        !           216:                              (buffer-substring
        !           217:                                (point)
        !           218:                                (save-excursion
        !           219:                                  (skip-chars-forward "[0-9]")
        !           220:                                  (point))))))
        !           221:                 nil))
        !           222: 
        !           223: (defun sort-fields (field beg end)
        !           224:   "Sort lines in region lexicographically by the ARGth field of each line.
        !           225: Fields are separated by whitespace and numbered from 1 up.
        !           226: With a negative arg, sorts by the -ARG'th field, in reverse order.
        !           227: Called from a program, there are three arguments:
        !           228: FIELD, BEG and END.  BEG and END specify region to sort."
        !           229:   (interactive "p\nr")
        !           230:   (sort-fields-1 field beg end
        !           231:                 (function (lambda ()
        !           232:                             (sort-skip-fields (1- field))
        !           233:                             nil))
        !           234:                 (function (lambda () (skip-chars-forward "^ \t\n")))))
        !           235: 
        !           236: (defun sort-fields-1 (field beg end startkeyfun endkeyfun)
        !           237:   (let ((reverse (< field 0))
        !           238:        (tbl (syntax-table)))
        !           239:     (setq field (max 1 field (- field)))
        !           240:     (unwind-protect
        !           241:        (save-restriction
        !           242:          (narrow-to-region beg end)
        !           243:          (goto-char (point-min))
        !           244:          (set-syntax-table sort-fields-syntax-table)
        !           245:          (sort-subr reverse
        !           246:                     'forward-line 'end-of-line
        !           247:                     startkeyfun endkeyfun))
        !           248:       (set-syntax-table tbl))))
        !           249: 
        !           250: (defun sort-skip-fields (n)
        !           251:   (let ((eol (save-excursion (end-of-line 1) (point))))
        !           252:     (forward-word n)
        !           253:     (if (> (point) eol)
        !           254:        (error "Line has too few fields: %s"
        !           255:               (buffer-substring (save-excursion
        !           256:                                   (beginning-of-line) (point))
        !           257:                                 eol)))
        !           258:     (skip-chars-forward " \t")))
        !           259: 
        !           260: 
        !           261: (defun sort-regexp-fields (reverse record-regexp key-regexp beg end)
        !           262:   "Sort the region lexicographically as specifed by RECORD-REGEXP and KEY.
        !           263: RECORD-REGEXP specifies the textual units which should be sorted.
        !           264:   For example, to sort lines RECORD-REGEXP would be \"^.*$\"
        !           265: KEY specifies the part of each record (ie each match for RECORD-REGEXP)
        !           266:   is to be used for sorting.
        !           267:   If it is \"\\digit\" then the digit'th \"\\(...\\)\" match field from
        !           268:   RECORD-REGEXP is used.
        !           269:   If it is \"\\&\" then the whole record is used.
        !           270:   Otherwise, it is a regular-expression for which to search within the record.
        !           271: If a match for KEY is not found within a record then that record is ignored.
        !           272: 
        !           273: With a negative prefix arg sorts in reverse order.
        !           274: 
        !           275: For example: to sort lines in the region by the first word on each line
        !           276:  starting with the letter \"f\",
        !           277:  RECORD-REGEXP would be \"^.*$\" and KEY \"\\<f\\w*\\>\""
        !           278:   (interactive "P\nsRegexp specifying records to sort: 
        !           279: sRegexp specifying key within record: \nr")
        !           280:   (cond ((or (equal key-regexp "") (equal key-regexp "\\&"))
        !           281:         (setq key-regexp 0))
        !           282:        ((string-match "\\`\\\\[1-9]\\'" key-regexp)
        !           283:         (setq key-regexp (- (aref key-regexp 1) ?0))))
        !           284:   (save-restriction
        !           285:     (narrow-to-region beg end)
        !           286:     (goto-char (point-min))
        !           287:     (let (sort-regexp-record-end) ;isn't dynamic scoping wonderful?
        !           288:       (re-search-forward record-regexp)
        !           289:       (setq sort-regexp-record-end (point))
        !           290:       (goto-char (match-beginning 0))
        !           291:       (sort-subr reverse
        !           292:                 (function (lambda ()
        !           293:                             (and (re-search-forward record-regexp nil 'move)
        !           294:                                  (setq sort-regexp-record-end (match-end 0))
        !           295:                                  (goto-char (match-beginning 0)))))
        !           296:                 (function (lambda ()
        !           297:                             (goto-char sort-regexp-record-end)))
        !           298:                 (function (lambda ()
        !           299:                             (let ((n 0))
        !           300:                               (cond ((numberp key-regexp)
        !           301:                                      (setq n key-regexp))
        !           302:                                     ((re-search-forward
        !           303:                                        key-regexp sort-regexp-record-end t)
        !           304:                                      (setq n 0))
        !           305:                                     (t (throw 'key nil)))
        !           306:                               (condition-case ()
        !           307:                                   (if (fboundp 'buffer-substring-lessp)
        !           308:                                       (cons (match-beginning n)
        !           309:                                             (match-end n))
        !           310:                                       (buffer-substring (match-beginning n)
        !           311:                                                         (match-end n)))
        !           312:                                 ;; if there was no such register
        !           313:                                 (error (throw 'key nil))))))))))
        !           314: 
        !           315: 
        !           316: (defun sort-columns (reverse &optional beg end)
        !           317:   "Sort lines in region alphabetically by a certain range of columns.
        !           318: For the purpose of this command, the region includes
        !           319: the entire line that point is in and the entire line the mark is in.
        !           320: The column positions of point and mark bound the range of columns to sort on.
        !           321: A prefix argument means sort into reverse order.
        !           322: 
        !           323: Note that sort-columns uses the sort utility program and therefore
        !           324: cannot work on text containing TAB characters.  Use M-x untabify
        !           325: to convert tabs to spaces before sorting."
        !           326:   (interactive "P\nr")
        !           327:   (save-excursion
        !           328:     (let (beg1 end1 col-beg1 col-end1 col-start col-end)
        !           329:       (goto-char (min beg end))
        !           330:       (setq col-beg1 (current-column))
        !           331:       (beginning-of-line)
        !           332:       (setq beg1 (point))
        !           333:       (goto-char (max beg end))
        !           334:       (setq col-end1 (current-column))
        !           335:       (forward-line)
        !           336:       (setq end1 (point))
        !           337:       (setq col-start (min col-beg1 col-end1))
        !           338:       (setq col-end (max col-beg1 col-end1))
        !           339:       (if (search-backward "\t" beg1 t)
        !           340:          (error "sort-columns does not work with tabs.  Use M-x untabify."))
        !           341:       (call-process-region beg1 end1 "sort" t t nil
        !           342:                           (if reverse "-rt\n" "-t\n")
        !           343:                            (concat "+0." col-start)
        !           344:                            (concat "-0." col-end)))))

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.