(provide (quote db-sort)) (defvar ordering-fields-converted) (defvar db-sort-modifies-p nil "\ *If non-nil, then sorting a database marks it as modified too.") (deflocalvar dbf-field-priorities nil "The list of field priorities for this database in this data display buffer. If non-nil, overrides the database's field-priorities slot.") (deflocalvar dbf-omitted-to-end-p nil "The default, local to this data display buffer, for the omitted-to-end-p database slot. Only used if dbf-field-priorities is non-nil.") (defun database-sort (database &optional sorter omitted-records-at-end-p) "\ Sort and return DATABASE, which is also side-effected. SORTER is either a field priorities list or a function which takes two records as arguments and returns t if r1 < r2." (byte-code "ÀˆÆÇ!ˆÈ !?…,ÀÉ !?…Ê \"ËK‰ˆÀˆÌ ÍÎ !Ï\"\")ˆ …8 ÐÅIˆÑ ˆÆÒ!ˆ ‡" [nil database ordering-fields-converted sorter db-sort-modifies-p t db-message "Sorting..." database-empty-p db-functionp db-convert-ordering-fields db-record-lessp database-set-links-from-list sort database-list-of-links (lambda (l1 l2) (byte-code "à ÄH ÄH#‡" [sorter l1 l2 funcall 6] 5)) 30 force-mode-line-update "Sorting...done."] 11)) (defun db-convert-ordering-fields (ordering-fields database) (byte-code "ÆÆÆÆÇÈ † ÉH@\",‡" [fieldno sortinfo type value ordering-fields database nil mapcar (lambda (this-cons) (byte-code " @ A‰ˆÇ !ƒÈÉ \" Ê=\"‚B @ A‰ˆË =ƒ- ‚BÌ =ƒ>ÍÎÏ \"#‚BÍÐ \"B‡" [fieldno this-cons sortinfo database type value t atom recordfieldspec-order-function database-recordfieldspec decreasing order-function sort-function error "Trying to order, but only sort function provided for field %s (%s)." fieldnumber->fieldname "Unrecognized type in %s"] 10)) 14] 4)) (defun db-make-ordering-fields-canonical (ordering-fields database) (byte-code " ÌHÍÃ\"ÃÃÃÎÏ @\"Ï A\" à Љˆ W…U H?…LÑÒÓPÔ \"\"ˆ ÕB B‰ ˆ T‰ˆ‚,ˆ ƒfÖ  \"‚h B. ‡" [no-of-fields database field-accounted-for nil fno sortinfo value check-field sig-fields ordering-fields nonsig-fields missing-fields 10 make-vector (lambda (this-cons) (byte-code "Ç @!ƒ @‚È @ \" A‰ˆ?ƒ(ÉÊËP @\"ˆÄ‚‘ Hƒ<ÉÊÌPÍ \"\"ˆÄ‚‘ ÆIˆ Î=ƒLÎ‚Ï !ƒh …Z Ð=?…cÉÊÑP \"ˆÐ‚ @Ò=†s @Ó=ƒŒÔ A!?…‡ÉÊÕP A @#ˆ ‚Ö× \"B‡" [fno this-cons database sortinfo nil field-accounted-for t numberp fieldname->fieldnumber db-message "Warning: " "%s is not a field in the database; ignoring it." "%s already appears; ignoring subsequent entries." fieldnumber->fieldname decreasing atom increasing "Unrecognized ordering symbol %s being changed to 'increasing." order-function sort-function db-functionp "%s is claimed to be a %s but doesn't look like a function to me." error "Unrecognized type in %s"] 13)) mapcar 0 db-message "Warning: " "%s doesn't appear; adding it." fieldnumber->fieldname increasing append] 9)) (defun db-order-records (record1 record2) (byte-code " ÇÇÈ…É !…-@@@AAÊ H H#‰ˆ‚ˆ ,‡" [ordering-fields ordering-fields-converted this-fieldno this-order-fn result record1 record2 nil 0 zerop funcall] 7)) (defun db-record-lessp (record1 record2) (byte-code "Âà \"U‡" [record1 record2 -1 db-order-records] 4)) (defun database-sorted-p (database &optional sorter) (byte-code "Á ?…ËKÌÁ \"‰ˆÅÅ ÍHÎ Å …t …tƒ;Á‰‚VÏ ÐHÎHÐH#…VÁ‰ˆÎH‰ˆÍH T‰ ˆ=…pÁ‰ ˆ‚*ˆÁ,ˆ *)‡" [ordering-fields-converted nil sorter database sorted t first-link-p first-link maplinks-link maplinks-index maplinks-not-done db-record-lessp db-convert-ordering-fields 2 1 funcall 6] 8)) (defun database-ordered-p (database &optional orderer) (byte-code "Á ?…ËKÌÁ \"‰ˆÁˆÅÅ ÍHÎ Å …p …pƒ=Á‰‚RÎÏ ÎHÐHÐH#U…RÁ‰ˆÍH T‰ ˆ=…lÁ‰ ˆ‚,ˆÁ,ˆ *)‡" [ordering-fields-converted nil orderer database ordered t first-link-p first-link maplinks-link maplinks-index maplinks-not-done db-order-records db-convert-ordering-fields 2 1 funcall 6] 9)) (defun database-no-identical-keys-p (database &optional orderer) (byte-code "Á ?…ËKÌÁ \"‰ˆÁˆÅÅ ÍHÎ Å …v …vƒ=Á‰‚XÏÐ ÎHÑHÑH#U…XÒÓÔP!ˆÁ‰ˆÍH T‰ ˆ=…rÁ‰ ˆ‚,ˆÁ,ˆ …‚ÕÖ!?*)‡" [ordering-fields-converted nil orderer database ordered t first-link-p first-link maplinks-link maplinks-index maplinks-not-done db-order-records db-convert-ordering-fields 2 1 0 funcall 6 db-message "Warning: " "Two elements with identical keys found." y-or-n-p "Proceed anyway?"] 9)) (defmacro with-orderer (database &rest body) (byte-code "ÂÃÄÅÆÇÈÉÊËÌÍÎE%ÏEED #‡" [database body append (let) ((ordering-fields-converted)) if (not orderer) progn list setq orderer (function db-order-records) ordering-fields-converted db-convert-ordering-fields nil (db-debug-message "with-orderer: setting orderer; ofc = %s" ordering-fields-converted)] 14)) (put (quote with-orderer) (quote lisp-indent-hook) 1) (put (quote with-orderer) (quote edebug-form-spec) (quote (&rest form))) (defmacro with-sorter (database &rest body) (byte-code "ÂÃÄÅÆÇÈÉÊËÌÍE%ED #‡" [database body append (let) ((ordering-fields-converted)) if (not sorter) list setq sorter (function db-record-lessp) ordering-fields-converted db-convert-ordering-fields nil] 13)) (put (quote with-sorter) (quote lisp-indent-hook) 1) (put (quote with-sorter) (quote edebug-form-spec) (quote (&rest form))) (defun database-sort-interface (database) (byte-code "Ë ÌH \"pÍÎÏ ÐHP!!ˆÑ ˆ   ÒHÇÇ@BÇAB‰ ˆÇ Ó ˆÔcˆÕÖKA\"ˆ×cˆÕÖK A\"ˆØÙ ƒUÚ‚VÛ\")ˆebˆÜÝ!*‡" [canonical-ordering-fields database data-display-buffer dbsi-data-display-buffer dbsi-database dbsi-omitted-to-end-p dbsi-killed-fields nil dbsi-sig-fields dbsi-nonsig-fields buffer-read-only db-make-ordering-fields-canonical 14 switch-to-buffer get-buffer-create "Ordering info for " 1 database-sort-interface-mode 15 erase-buffer "==== Significant fields: " mapcar dbsi-format "==== Nonsignificant fields: " insert "==== Omitted records to end: " "Yes" "No " db-message "u = use, RET = also make default, ! = this field only, q = abort, ? = help"] 12)) (defun database-sort-interface-mode nil "\ Sort interface buffer for choosing fields upon which to sort a database. \\ Reorder the fields with the following commands: \\[dbsi-kill-line] Kill field under point. \\[dbsi-yank-line] Yank most recently killed field. Specify how a particular field should be ordered with these commands: \\[dbsi-increasing] Sort the field under point in increasing order. \\[dbsi-decreasing] Sort the field under point in decreasing order. \\[dbsi-ordering-function] Specify an ordering function for the field at point. \\[dbsi-sorting-function] Specify a sorting function for the field at point. Change whether omitted records go at the end of the sorted order with: \\[dbsi-toggle-omitted-to-end] Toggle the value of dbsi-omitted-to-end-p. Exit the sort interface with the following commands: \\[dbsi-use-ordering-make-database-default] Use this ordering, and make it the default for this database. \\[dbsi-use-ordering-make-buffer-default] Use this ordering, and make it the default in this buffer only. \\[dbsi-quit-clear-buffer-default] Clear the default sort in this buffer, and abort the sort. \\[dbsi-use-ordering] Use this ordering, but don't make it the default. \\[dbsi-this-field-only] Sort only according to the field at point. \\[dbsi-quit] Abort the sort; don't change the default ordering criterion. More specifically: \\{database-sort-mode-map}" (byte-code "ɉˆÊ‰ˆËÂ!ˆÄ‰ˆÌÍ!ˆÂ‰ˆÄ‰ˆÎ!ˆÏ‰‡" [major-mode mode-name nil buffer-read-only t buffer-file-name truncate-lines database-sort-mode-map mode-line-format database-sort-interface-mode "Database Sort Interface" set-buffer-modified-p auto-save-mode 0 use-local-map ("---Database Sort: %17b [" (-3 . "%p") "]-%-")] 5)) (deflocalvar dbsi-data-display-buffer) (deflocalvar dbsi-database nil) (deflocalvar dbsi-killed-fields nil) (deflocalvar dbsi-sig-fields nil) (deflocalvar dbsi-nonsig-fields nil) (deflocalvar dbsi-omitted-to-end-p nil "The omitted-to-end slot of the database will be set from this variable.") (defvar database-sort-mode-map (make-keymap)) (suppress-keymap database-sort-mode-map) (define-key database-sort-mode-map " " (quote dbsi-kill-line)) (define-key database-sort-mode-map "" (quote dbsi-yank-line)) (define-key database-sort-mode-map "!" (quote dbsi-this-field-only)) (define-key database-sort-mode-map " " (quote dbsi-use-ordering-make-database-default)) (define-key database-sort-mode-map "" (quote dbsi-use-ordering-make-database-default)) (define-key database-sort-mode-map "A" (quote dbsi-use-ordering-make-buffer-default)) (define-key database-sort-mode-map "U" (quote dbsi-use-ordering-make-buffer-default)) (define-key database-sort-mode-map "c" (quote dbsi-quit-clear-buffer-default)) (define-key database-sort-mode-map "a" (quote dbsi-use-ordering)) (define-key database-sort-mode-map "u" (quote dbsi-use-ordering)) (define-key database-sort-mode-map "t" (quote dbsi-toggle-omitted-to-end)) (define-key database-sort-mode-map "o" (quote dbsi-ordering-function)) (define-key database-sort-mode-map "s" (quote dbsi-sorting-function)) (define-key database-sort-mode-map "i" (quote dbsi-increasing)) (define-key database-sort-mode-map "d" (quote dbsi-decreasing)) (define-key database-sort-mode-map "q" (quote dbsi-quit)) (define-key database-sort-mode-map "?" (quote describe-mode)) (defmacro with-pc (&rest body) (byte-code "ÁÂÃÄÅÆ\"ÇFE‡" [body let ((pc (dbsi-prev-cons)) (buffer-read-only nil)) if pc append (progn) (error "Can't insert here.")] 7)) (put (quote with-pc) (quote lisp-indent-hook) 0) (put (quote with-pc) (quote edebug-form-spec) (quote (&rest form))) (defmacro with-pc-and-ti (&rest body) (byte-code "ÁÂÃÄÅÆ\"ÇFE‡" [body let* ((pc (dbsi-prev-cons)) (ti (car (cdr pc))) (buffer-read-only nil)) if ti append (progn) (error "No field on current line.")] 7)) (put (quote with-pc-and-ti) (quote lisp-indent-hook) 0) (put (quote with-pc-and-ti) (quote edebug-form-spec) (quote (&rest form))) (defun dbsi-prev-cons nil (byte-code "ŠÅ ˆÆe`\")ÁˆÇ!ƒÁ‚; GXƒ%ÈS \"‚;É GÊ#‰ˆÁˆ GW…;È \")‡" [line-no nil dbsi-sig-fields t dbsi-nonsig-fields beginning-of-line count-lines zerop nthcdr - 1] 8)) (defun dbsi-format (item) (byte-code "ÃÄÅ @ \"\"ÆÇÈÉÊGZ]Ë\"Ì$)ˆÍ A!ƒ)ÃÄ A\"c‚3ÃÎ AA A@#cˆÏc‡" [name item dbsi-database format "%s" fieldnumber->fieldname insert " " make-string 0 20 32 " " atom "%s [%s]" " "] 10)) (defun dbsi-reformat (item) (byte-code "Á ˆÂÃ!ˆÄ!‡" [item beginning-of-line kill-line 1 dbsi-format] 4)) (defun dbsi-kill-line nil "\ Kill field on current line, placing it in the sort interface kill stack." (interactive) (byte-code "ÈŠA@à ƒ% B‰ˆÆAA\"ˆÇ ˆÈÉ!‚(ÊË!+‡" [pc ti buffer-read-only nil dbsi-killed-fields dbsi-prev-cons setcdr beginning-of-line kill-line 1 error "No field on current line."] 6)) (defun dbsi-yank-line nil "\ Yank most recently killed (lifo ordering) field, inserting it before point. This removes the field from the sort interface kill stack." (interactive) (byte-code "ˆŠÂƒ3 ƒ- @Æ ˆÇ AB\"ˆÈ !ˆÉÊ!ˆ A‰)‚0ËÌ!‚6ËÍ!*‡" [pc buffer-read-only nil dbsi-killed-fields ti dbsi-prev-cons beginning-of-line setcdr dbsi-format previous-line 1 error "Nothing to yank." "Can't insert here."] 8)) (defun dbsi-toggle-omitted-to-end nil "\ Toggle the boolean value of dbsi-omitted-to-end-p. This controls whether omitted records should all be placed at the end of the sorted order or should be sorted according to the same criteria as non-omitted records." (interactive) (byte-code "ÁˆŠÁ ?‰ˆdbˆÃÄ!ˆ ƒÅ‚Æc))‡" [buffer-read-only nil dbsi-omitted-to-end-p backward-delete-char 3 "Yes" "No "] 2)) (defun dbsi-increasing nil "\ Specify that the field at point should use an increasing ordering." (interactive) (byte-code "ÃˆÄ A@à ƒÅ Æ\"ˆÇ !‚ÈÉ!+‡" [pc ti buffer-read-only nil dbsi-prev-cons setcdr increasing dbsi-reformat error "No field on current line."] 5)) (defun dbsi-decreasing nil "\ Specify that the field at point should use a decreasing ordering." (interactive) (byte-code "ÃˆÄ A@à ƒÅ Æ\"ˆÇ !‚ÈÉ!+‡" [pc ti buffer-read-only nil dbsi-prev-cons setcdr decreasing dbsi-reformat error "No field on current line."] 5)) (defun dbsi-ordering-function nil "\ Specify an ordering function for the field at point. An ``ordering function'' returns -1, 0, or 1 depending on whether its first argument is less than, equivalent to, or greater than its second argument." (interactive) (byte-code "ÈŠA@à ƒ!Æ ÇÈÉÃÃÄ$B\"ˆÊ !‚$ËÌ!+‡" [pc ti buffer-read-only nil t dbsi-prev-cons setcdr order-function read-from-minibuffer "Ordering function: " dbsi-reformat error "No field on current line."] 9)) (defun dbsi-sorting-function nil "\ Specify a sorting function for the field at point. A ``sorting function'' returns t if its first argument is less than its second argument and nil otherwise." (interactive) (byte-code "ÈŠA@à ƒ!Æ ÇÈÉÃÃÄ$B\"ˆÊ !‚$ËÌ!+‡" [pc ti buffer-read-only nil t dbsi-prev-cons setcdr sort-function read-from-minibuffer "Sorting function: " dbsi-reformat error "No field on current line."] 9)) (defun dbsi-quit nil "\ Abort the sort and exit the sort interface." (interactive) (byte-code "ˆ Ãp!ˆÄ!ˆÅÆ!)‡" [data-display-buffer dbsi-data-display-buffer nil kill-buffer switch-to-buffer db-message "Aborting sort."] 4)) (defun dbsi-quit-clear-buffer-default nil "\ Clear the default sort order for this buffer and exit the sort interface without sorting. In the future, the default sort order will come from the database." (interactive) (byte-code "È Äp!ˆÅ!ˆÃ‰ˆÆÇ!)‡" [data-display-buffer dbsi-data-display-buffer dbf-field-priorities nil kill-buffer switch-to-buffer db-message "Reset buffer-local default sort order; didn't sort."] 4)) (defun dbsi-killed-fields-to-end-maybe nil (byte-code "A…ÂÃ!ƒÄ A\"‚ÅÆ!‡" [dbsi-killed-fields dbsi-nonsig-fields y-or-n-p "Put killed but not yanked fields at end of nonsignificant list? " nconc error "There are still killed fields."] 4)) (defun dbsi-use-ordering-make-database-default nil "\ Use the current ordering to sort, and make it the default for future sorts of this database. The user is warned if there are killed, non-yanked fields." (interactive) (byte-code "ÄˆË ˆÌ !p =ƒĉ‚TÍŽqˆÎ! Ï =?…-Ð !`=ĉ…Jp=…J Î!=…J Ï =?…QÑ `\"ˆ*)*ˆÒA ABIˆÓ IˆÔÒH!‡" [target-buffer dbsi-data-display-buffer this-buffer dbf-field-priorities nil target-window track-window-point-p dbsi-database dbsi-sig-fields dbsi-nonsig-fields dbsi-omitted-to-end-p dbsi-killed-fields-to-end-maybe get-buffer-create ((byte-code "Á!… Â!…q‡" [this-buffer bufferp buffer-name] 3)) get-buffer-window selected-window window-point set-window-point 14 15 dbsi-use-ordering] 12)) (defun dbsi-use-ordering-make-buffer-default nil "\ Use the current ordering to sort, and make it the default for future sorts in this data display buffer only. The user is warned if there are killed, non-yanked fields." (interactive) (byte-code "ËˆÌ ˆ A ABÍ !p =ƒ\"‰‚jÎŽ qˆÏ !  Ð =?…;Ñ !`= ‰ …_p =…_ Ï !=…_ Ð =?…gÒ `\"ˆ*)*ˆÓ!)‡" [ordering dbsi-sig-fields dbsi-nonsig-fields target-buffer dbsi-data-display-buffer this-buffer dbf-field-priorities dbf-omitted-to-end-p dbsi-omitted-to-end-p target-window track-window-point-p nil dbsi-killed-fields-to-end-maybe get-buffer-create ((byte-code "Á!… Â!…q‡" [this-buffer bufferp buffer-name] 3)) get-buffer-window selected-window window-point set-window-point dbsi-use-ordering] 11)) (defun dbsi-use-ordering (&optional ordering) "\ Use the current ordering for this sort only." (interactive) (byte-code "ÀˆÀˆÇ † AÀB #ˆÈp!ˆÉ !ˆÊ )‡" [nil dbsi-database ordering dbsi-sig-fields dbsi-omitted-to-end-p data-display-buffer dbsi-data-display-buffer database-sort kill-buffer switch-to-buffer dbf-finished-sorting] 5)) (defun dbsi-this-field-only nil "\ Sort according to only the field at point. All editing of other fields is ignored." (interactive) (byte-code "ÈÊË A@à ƒ] @ AÌ !ƒ)ÍÎ \" Ï=\"‚F @ A Ð=ƒ<Ñ‚EÆ=…E A*ÒÓÔÕDÖ× EÖØ EFE+‚`ÙÚ!+!‡" [pc ti buffer-read-only nil fieldno sortinfo sort-function dbsi-database car-sortinfo cdr-sortinfo dbsi-use-ordering dbsi-prev-cons atom recordfieldspec-sort-function database-recordfieldspec decreasing order-function (lambda (item1 item2) (byte-code "ÃÄA #U‡" [sortinfo item1 item2 -1 funcall] 5)) lambda (record1 record2) funcall function aref record1 record2 error "No field on current line."] 13))