Function: gnus-parse-simple-format

gnus-parse-simple-format is a byte-compiled function defined in gnus-spec.el.gz.

Signature

(gnus-parse-simple-format FORMAT SPEC-ALIST &optional INSERT)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-spec.el.gz
(defun gnus-parse-simple-format (format spec-alist &optional insert)
  ;; This function parses the FORMAT string with the help of the
  ;; SPEC-ALIST and returns a list that can be eval'ed to return a
  ;; string.
  (let ((max-width 0)
	spec flist fstring elem result dontinsert user-defined
	type value pad-width spec-beg cut-width ignore-value
	tilde-form tilde elem-type extended-spec)
    (save-excursion
      (gnus-set-work-buffer)
      (insert format)
      (goto-char (point-min))
      (while (re-search-forward "%" nil t)
	(setq user-defined nil
	      spec-beg nil
	      pad-width nil
	      max-width nil
	      cut-width nil
	      ignore-value nil
	      tilde-form nil
	      extended-spec nil)
	(setq spec-beg (1- (point)))

	;; Parse this spec fully.
	(while
	    (cond
	     ((looking-at "\\([-.0-9]+\\)\\(,[-0-9]+\\)?")
	      (setq pad-width (string-to-number (match-string 1)))
	      (when (match-beginning 2)
		(setq max-width (string-to-number (buffer-substring
						   (1+ (match-beginning 2))
						   (match-end 2)))))
	      (goto-char (match-end 0)))
	     ((looking-at "~")
	      (forward-char 1)
	      (setq tilde (read (current-buffer))
		    type (car tilde)
		    value (cadr tilde))
	      (cond
	       ((memq type '(pad pad-left))
		(setq pad-width value))
	       ((eq type 'pad-right)
		(setq pad-width (- value)))
	       ((memq type '(max-right max))
		(setq max-width value))
	       ((eq type 'max-left)
		(setq max-width (- value)))
	       ((memq type '(cut cut-left))
		(setq cut-width value))
	       ((eq type 'cut-right)
		(setq cut-width (- value)))
	       ((eq type 'ignore)
		(setq ignore-value
		      (if (stringp value) value (format "%s" value))))
	       ((eq type 'form)
		(setq tilde-form value))
	       (t
		(error "Unknown tilde type: %s" tilde)))
	      t)
	     (t
	      nil)))
	(cond
	 ;; User-defined spec -- find the spec name.
	 ((eq (setq spec (char-after)) ?u)
	  (forward-char 1)
	  (when (and (eq (setq user-defined (char-after)) ?&)
		     (looking-at "&\\([^;]+\\);"))
	    (setq user-defined (match-string 1))
	    (goto-char (match-end 1))))
	 ;; extended spec
	 ((and (eq spec ?&) (looking-at "&\\([^;]+\\);"))
	  (setq extended-spec (intern (match-string 1)))
	  (goto-char (match-end 1))))
	(forward-char 1)
	(delete-region spec-beg (point))

	;; Now we have all the relevant data on this spec, so
	;; we start doing stuff.
	(insert "%")
	(if (eq spec ?%)
	    ;; "%%" just results in a "%".
	    (insert "%")
	  (setq elem
                (cond
                 ;; Do tilde forms.
                 ((eq spec ?@)
                  (list tilde-form ?s))
                 ;; Treat user defined format specifiers specially.
                 (user-defined
		  (list
		   (list (intern (format
				  (if (stringp user-defined)
				      "gnus-user-format-function-%s"
				    "gnus-user-format-function-%c")
				  user-defined))
			 'gnus-tmp-header)
		   ?s))
                 ;; Find the specification from `spec-alist'.
                 ((cdr (assq (or extended-spec spec) spec-alist)))
                 ;; We used to use "%l" for displaying the grouplens score.
                 ((eq spec ?l)
                  '("" ?s))
                 (t
                  '("*" ?s))))
	  (setq elem-type (cadr elem))
	  ;; Insert the new format elements.
	  (when pad-width
	    (insert (number-to-string pad-width)))
	  ;; Create the form to be evalled.
	  (if (or max-width cut-width ignore-value)
	      (progn
		(insert ?s)
		(let ((el (car elem)))
		  (cond ((= (cadr elem) ?c)
			 (setq el (list 'char-to-string el)))
			((= (cadr elem) ?d)
			 (setq el (list 'int-to-string el))))
		  (when ignore-value
		    (setq el (gnus-tilde-ignore-form el ignore-value)))
		  (when cut-width
		    (setq el (gnus-tilde-cut-form el cut-width)))
		  (when max-width
		    (setq el (gnus-tilde-max-form el max-width)))
		  (when pad-width
		    (setq el (gnus-pad-form el pad-width)))
		  (push el flist)))
	    (insert elem-type)
	    (push (car elem) flist))))
      (setq fstring (buffer-substring-no-properties (point-min) (point-max))))

    ;; Do some postprocessing to increase efficiency.
    (setq
     result
     (cond
      ;; Emptiness.
      ((string= fstring "")
       nil)
      ;; Not a format string.
      ((not (string-search "%" fstring))
       (list fstring))
      ;; A format string with just a single string spec.
      ((string= fstring "%s")
       (list (car flist)))
      ;; A single character.
      ((string= fstring "%c")
       (list (car flist)))
      ;; A single number.
      ((string= fstring "%d")
       (setq dontinsert t)
       (if insert
	   `(insert (int-to-string ,(car flist)))
	 (list `(int-to-string ,(car flist)))))
      ;; Just lots of chars and strings.
      ((string-match "\\`\\(%[cs]\\)+\\'" fstring)
       (nreverse flist))
      ;; A single string spec at the beginning of the spec.
      ((string-match "\\`%[sc][^%]+\\'" fstring)
       (list (car flist) (substring fstring 2)))
      ;; A single string spec in the middle of the spec.
      ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring)
       (list (match-string 1 fstring) (car flist) (match-string 2 fstring)))
      ;; A single string spec in the end of the spec.
      ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring)
       (list (match-string 1 fstring) (car flist)))
      ;; A more complex spec.
      (t
       (list (cons 'format (cons fstring (nreverse flist)))))))

    (if insert
	(when result
	  (if dontinsert
	      result
	    (cons 'insert result)))
      (cond ((stringp result)
	     result)
	    ((consp result)
	     (cons 'concat result))
	    (t "")))))