;;; Code:
;;
-
+(require 'bytecomp)
(eval-when-compile
(require 'elmo-util))
;;(defalias 'wl-set-hash-val 'elmo-set-hash-val)
;;(make-obsolete 'wl-set-hash-val 'elmo-set-hash-val)
-(defsubst wl-set-string-width (width string)
+(defsubst wl-set-string-width (width string &optional padding)
+ "Make a new string which have specified WIDTH and content of STRING.
+If WIDTH is negative number, padding chars are added to the head and
+otherwise, padding chars are added to the tail of the string.
+The optional 3rd arg PADDING, if non-nil, specifies a padding character
+to add the result instead of white space."
(static-cond
((and (fboundp 'string-width) (fboundp 'truncate-string-to-width)
(not (featurep 'xemacs)))
- (if (> (string-width string) width)
- (setq string (truncate-string-to-width string width)))
- (if (= (string-width string) width)
+ (if (> (string-width string) (abs width))
+ (setq string (truncate-string-to-width string (abs width))))
+ (if (= (string-width string) (abs width))
string
- (concat string
- (format (format "%%%ds"
- (- width (string-width string)))
- " "))))
+ (let ((paddings (make-string (- (abs width) (string-width string))
+ (or padding ?\ ))))
+ (if (< width 0)
+ (concat paddings string)
+ (concat string paddings)))))
(t
(elmo-set-work-buf
(elmo-set-buffer-multibyte default-enable-multibyte-characters)
(insert string)
- (if (> (current-column) width)
- (if (> (move-to-column width) width)
- (progn
- (condition-case nil ; ignore error
- (backward-char 1)
- (error))
- (concat (buffer-substring (point-min) (point)) " "))
- (buffer-substring (point-min) (point)))
- (if (= (current-column) width)
- string
- (concat string
- (format (format "%%%ds"
- (- width (current-column)))
- " "))))))))
-
-(defun wl-display-bytes (num)
- (let (result remain)
- (cond
- ((> (setq result (/ num 1000000)) 0)
- (setq remain (% num 1000000))
- (if (> remain 400000)
- (setq result (+ 1 result)))
- (format "%dM" result))
- ((> (setq result (/ num 1000)) 0)
- (setq remain (% num 1000))
- (if (> remain 400)
- (setq result (+ 1 result)))
- (format "%dK" result))
- (t (format "%dB" num)))))
+ (when (> (current-column) (abs width))
+ (when (> (move-to-column (abs width)) (abs width))
+ (condition-case nil ; ignore error
+ (backward-char 1)
+ (error)))
+ (setq string (buffer-substring (point-min) (point))))
+ (if (= (current-column) (abs width))
+ string
+ (let ((paddings (make-string (- (abs width) (current-column))
+ (or padding ?\ ))))
+ (if (< width 0)
+ (concat paddings string)
+ (concat string paddings))))))))
(defun wl-mode-line-buffer-identification (&optional id)
(let ((priorities '(biff plug title)))
(apply (function concat) (nreverse expanded))
newtext)))
+(defvar wl-line-string)
+(defun wl-line-parse-format (format spec-alist)
+ "Make a formatter from FORMAT and SPEC-ALIST."
+ (let (f spec specs stack)
+ (setq f
+ (with-temp-buffer
+ (insert format)
+ (goto-char (point-min))
+ (while (search-forward "%" nil t)
+ (cond
+ ((looking-at "%")
+ (goto-char (match-end 0)))
+ ((looking-at "\\(-?\\(0?\\)[0-9]*\\)\\([^0-9]\\)")
+ (cond
+ ((string= (match-string 3) "(")
+ (if (zerop (length (match-string 1)))
+ (error "No number specification for %%( line format"))
+ (push (list
+ (match-beginning 0) ; start
+ (match-end 0) ; start-content
+ (string-to-number
+ (match-string 1)) ; width
+ specs) ; specs
+ stack)
+ (setq specs nil))
+ ((string= (match-string 3) ")")
+ (let ((entry (pop stack))
+ form)
+ (unless entry
+ (error
+ "No matching %%( parenthesis in summary line format"))
+ (goto-char (car entry)) ; start
+ (setq form (buffer-substring (nth 1 entry) ; start-content
+ (- (match-beginning 0) 1)))
+ (delete-region (car entry) (match-end 0))
+ (insert "s")
+ (setq specs
+ (append
+ (nth 3 entry)
+ (list (list 'wl-set-string-width (nth 2 entry)
+ (append
+ (list 'format form)
+ specs)))))))
+ (t
+ (setq spec
+ (if (setq spec (assq (string-to-char (match-string 3))
+ spec-alist))
+ (nth 1 spec)
+ (match-string 3)))
+ (unless (string= "" (match-string 1))
+ (setq spec (list 'wl-set-string-width
+ (string-to-number (match-string 1))
+ spec
+ (unless (string= "" (match-string 2))
+ (string-to-char (match-string 2))))))
+ (replace-match "s" 'fixed)
+ (setq specs (append specs
+ (list
+ (list
+ 'setq 'wl-line-string
+ spec)))))))))
+ (buffer-string)))
+ (append (list 'format f) specs)))
+
+(defmacro wl-line-formatter-setup (formatter format alist)
+ (` (let (byte-compile-warnings)
+ (setq (, formatter)
+ (byte-compile
+ (list 'lambda ()
+ (wl-line-parse-format (, format) (, alist)))))
+ (when (get-buffer "*Compile-Log*")
+ (bury-buffer "*Compile-Log*"))
+ (when (get-buffer "*Compile-Log-Show*")
+ (bury-buffer "*Compile-Log-Show*")))))
+
(require 'product)
(product-provide (provide 'wl-util) (require 'wl-version))
projects / elisp / wanderlust.git / blobdiff