;; '(("MR" "Buffer"                    "Rev"     "Proc"    "Size" "Mode"        "File")
;;   ("--" "------"                    "---"     "----"    "----" "----"        "----")
;;   ("."  "TODO.html"                 "RCS:1.3" ""        "9367" "XML"         "~/lib/misc/TODO.html")
;;   ("*"  "reply to www@perforce.com" ""        ""        "1899" "Mail")
;;   ("*%" "inbox<P>"                  ""        ""        "1916" "VMP")
;;   ("*%" "inbox Summary"             ""        ""       "87770" "VM Summary")
;;   ("*%" "inbox"                     ""        ""     "4700944" "VM"          "~/etc/mail/org/perforce.com/inbox")
;;   ("*"  "*bld-win2003*"             ""        "run"    "76203" "ssh"         "~/src/release/")
;;   (""   "test-p4d.sh"               "~7~"     ""       "11235" "[sh]"        "~/src/release/s06.1/tools/scripts/test-p4d.sh")
;;   ("*"  "*perforce@bld-aix53-ppc*"  ""        "run"      "150" "rlogin"      "/usr/perforce/tmp/wally/r061/")
;;   (""   "p4pymarshal.el"            "~5~"     ""        "5724" "Elisp"       "~/lib/elisp/noahf/p4pymarshal.el")
;;   ("%"  ",user"                     ""        ""        "1739" "Text"        "~/,user")
;;   ("*"  "*debug-shell*"             ""        "run"   "307239" "shell"       "~/src/release/s06.1/p4-bin/")
;;   ("*"  "*sudo*"                    ""        "run"      "228" "shell"       "~/")
;;   ("*"  "*canonical address*"       ""        ""          "30" "Fundamental")
;;   ("*"  "*extract address components*"  ""    ""          "30" "Fundamental")
;;   ("*"  "*vc*"                      ""        ""          "59" "Fundamental")
;;   ("*"  "*code-converting-work*"    ""        ""        "4096" "Fundamental")
;;   ("*"  "*shell*"                   ""        "run"        "4" "shell"       "~/"))

(defvar fmtcols-config-default
  '(:output-separator        " " ; string
    :input-separator         (regexp "[ \t]+") ; literal string or (regexp "re")

    :max-columns             nil ; int or nil
    :min-width               0   ; int or list/vect (2 14  3 4 4 ...)
    :max-width               nil ; int or list/vect (2 20 10 6 6 ...)
    :max-truncate            nil ; nil, t, '(0 1 2 ...) or [nil t t nil ...]

    :right-justify           nil ; nil, t, '(0 1 2 ...) or [nil t t nil ...]
    :right-justify-numeric   t
    :numeric-regexp          "^[+-]?[0-9.]+%?$"

    :skip-leading-whitespace t   ; t or nil
    :ignore-line-regexp      nil ; if re, do not format line
    :skip-first-lines        nil ; if int, do not format first n lines

    :formats                 ((float      "^[+-]?[0-9]*\\.[0-9]+$" "%.2f")
                              (integer    "^[+-]?[0-9]+$"          "%d")
                              (currency   "^[+-]?[0-9]*\\.[0-9]+$" "$%.2f")
                              (ipct       "^[+-]?[0-9]+%$"         "%d%%")
                              (fpct       "^[+-]?[0-9.]+%$"        "%.2f%%"))

    :use-defaults            t))

(defun fmtcols-config-param (param &optional config)
  (let ((elt (plist-member config param)))
    (cond (elt ; pair exists
           (cadr elt))
          ((setq elt (plist-member config :use-defaults))
           (if (cadr elt) ; pair exists; is cadr non-nil?
               (cadr (plist-member fmtcols-config-default param))))
          ((setq elt (plist-member fmtcols-config-default :use-defaults))
           (if (cadr elt)
               (cadr (plist-member fmtcols-config-default param)))))))

(defun fmtcols-config-param-column (param column &optional config)
  (let ((row (fmtcols-config-param param config)))
        (cond ((vectorp row)
               (and (< column (length row))
                    (aref row column)))
              ((consp row)
               (nth column row))
              (t row))))

;; A boolean column param differs from a normal one in that if the
;; parameter is specified as a list, it should contain column numbers
;; rather than a list of t/nil values.
;; For vector params, there is no difference although any columns beyond
;; the length of the vector will return nil.
;;
;; The canonical example of a boolean column list is :right-justify
(defun fmtcols-config-param-column-bool (param column &optional config)
  (let ((row (fmtcols-config-param param config)))
        (cond ((vectorp row)
               (and (< column (length row))
                    (aref row column)))
              ((consp row)
               (member column row))
              (t row))))

(defun fmtcols-config-min-width (column &optional config)
  (or (fmtcols-config-param-column :min-width column config)
      0))

(defun fmtcols-config-max-width (column &optional config maxintp)
  (or (fmtcols-config-param-column :max-width column config)
      (and maxintp (lsh -1 -1))))

(defun fmtcols-config-formatter (type &optional config)
  (nth 2 (assq type (fmtcols-config-param :formats config))))


(defun fmtcols-enlarge-vector (old newsize &optional init)
  (when (sequencep newsize)
    (setq newsize (length newsize)))
  (cond ((> newsize (length old))
         (let ((new (make-vector newsize init))
               (i 0))
           (mapc (lambda (v)
                   (aset new i v)
                   (setq i (1+ i)))
             old)
           new))
        (t old)))

(defun fmtcols-print-length (obj &optional config)
  (let* ((type (type-of obj))
         (fmtstr (or (fmtcols-config-formatter type config)
                     "%s")))
    (cond ((memq type '(integer float))
           (length (format fmtstr obj)))
          ((eq type 'symbol)
           (length (symbol-name obj)))
          (t
           (length obj)))))

(defun fmtcols-actual-maxwidths (table)
  (let ((w nil))
    (mapc (lambda (row)
            (when (consp row)
              (setq w (fmtcols-enlarge-vector w row 0)
                    i 0)
              (mapc (lambda (v)
                      (aset w i (max (aref w i)
                                     (if (stringp v)
                                         (length v)
                                       (length (format "%s" v)))))
                      (setq i (1+ i)))
                row)))
      table)
    w))

(defun fmtcols-format-widths (table &optional config)
  (let ((width      (fmtcols-actual-maxwidths table))
        (num-re     (fmtcols-config-param :numeric-regexp        config))
        (rj-numeric (fmtcols-config-param :right-justify-numeric config))
        (i 0)
        sign)
    (mapc (lambda (col)
            (setq col  (max col (fmtcols-config-min-width i config))
                  sign -1) ; left-justify by default

            (cond ((fmtcols-config-param-column-bool :right-justify i config)
                   (setq sign 1))
                  ((and rj-numeric
                        (setq sign (catch 'rjp
                                     (mapc (lambda (row)
                                             (or (stringp row)
                                                 (string-match num-re (nth i row))
                                                 (throw 'rjp -1)))
                                       table)
                                     1)))))
            (aset width i (* sign col))
            (setq i (1+ i)))
      width)
    width))

(defun fmtcols-make-format-string (table &optional config)
  (let ((widths     (fmtcols-format-widths table config))
        (output-sep (fmtcols-config-param :output-separator config))
        (max-width  nil)
        (i          0)
        sign)
    (mapconcat
     (lambda (width)
       (setq max-width (fmtcols-config-param-column      :max-width     i config)
             trunc     (fmtcols-config-param-column-bool :max-truncate  i config)
             i         (1+ i)
             sign      (if (< width 0) -1 1))

       (cond ((and (null max-width)
                   (< sign 0)
                   (= i (length widths)))
              ;; If the last column is left-justified and there is no
              ;; truncation, there's no need to pad every row to the maximum width.
              "%s")

             ((or (null max-width)
                  (<= (abs width) max-width))
              (format "%%%ds" width))

             (trunc
              (format "%%%d.%ds" (* sign max-width) max-width))

             (t
              (format "%%%ds" (* sign max-width)))))
     widths
     output-sep)))

(defun fmtcols-split-lines (config &rest lines)
  (let ((re        (fmtcols-config-param :input-separator         config))
        (skip-lw   (fmtcols-config-param :skip-leading-whitespace config))
        (ignore-re (fmtcols-config-param :ignore-line-regexp      config))
        (skip-n    (fmtcols-config-param :skip-first-lines        config)))
    (cond ((and (consp re)
                (eq 'regexp (car re)))
           (setq re (car (cdr re))))
          ((stringp re)
           (setq re (regexp-quote re))))
    (let ((n -1))
      (mapcar (lambda (l)
                (cond ((string= "" l)
                       l)

                      ((and skip-n
                            (< (setq n (1+ n))
                               skip-n))
                       l)
                      ((and ignore-re
                            (string-match ignore-re l))
                       l)

                      ((and skip-lw
                            (string-match (concat "^" re) l)
                            (setq l (substring l (match-end 0)))
                            nil))

                      (t
                       (split-string l re))))
              lines))))

(put 'fmtcols-split-lines 'lisp-indent-function 1)

(defun fmtcols-split-text (config text)
  (apply 'fmtcols-split-lines config
         (split-string text "[\r\n]+")))

(put 'fmtcols-split-text 'lisp-indent-function 1)

;; fmtcols.el ends here