cgit.sxemacs.org Git - gnus/blob - lisp/gnus-spec.el

   1 ;;; gnus-spec.el --- format spec functions for Gnus
   2 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
   3 ;;        Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   6 ;; Keywords: news
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 (eval-when-compile (require 'cl))
  30
  31 (require 'gnus)
  32
  33 (defcustom gnus-use-correct-string-widths (featurep 'xemacs)
  34   "*If non-nil, use correct functions for dealing with wide characters."
  35   :group 'gnus-format
  36   :type 'boolean)
  37
  38 ;;; Internal variables.
  39
  40 (defvar gnus-summary-mark-positions nil)
  41 (defvar gnus-group-mark-positions nil)
  42 (defvar gnus-group-indentation "")
  43
  44 ;; Format specs.  The chunks below are the machine-generated forms
  45 ;; that are to be evaled as the result of the default format strings.
  46 ;; We write them in here to get them byte-compiled.  That way the
  47 ;; default actions will be quite fast, while still retaining the full
  48 ;; flexibility of the user-defined format specs.
  49
  50 ;; First we have lots of dummy defvars to let the compiler know these
  51 ;; are really dynamic variables.
  52
  53 (defvar gnus-tmp-unread)
  54 (defvar gnus-tmp-replied)
  55 (defvar gnus-tmp-score-char)
  56 (defvar gnus-tmp-indentation)
  57 (defvar gnus-tmp-opening-bracket)
  58 (defvar gnus-tmp-lines)
  59 (defvar gnus-tmp-name)
  60 (defvar gnus-tmp-closing-bracket)
  61 (defvar gnus-tmp-subject-or-nil)
  62 (defvar gnus-tmp-subject)
  63 (defvar gnus-tmp-marked)
  64 (defvar gnus-tmp-marked-mark)
  65 (defvar gnus-tmp-subscribed)
  66 (defvar gnus-tmp-process-marked)
  67 (defvar gnus-tmp-number-of-unread)
  68 (defvar gnus-tmp-group-name)
  69 (defvar gnus-tmp-group)
  70 (defvar gnus-tmp-article-number)
  71 (defvar gnus-tmp-unread-and-unselected)
  72 (defvar gnus-tmp-news-method)
  73 (defvar gnus-tmp-news-server)
  74 (defvar gnus-tmp-article-number)
  75 (defvar gnus-mouse-face)
  76 (defvar gnus-mouse-face-prop)
  77
  78 (defun gnus-summary-line-format-spec ()
  79   (insert gnus-tmp-unread gnus-tmp-replied
  80           gnus-tmp-score-char gnus-tmp-indentation)
  81   (gnus-put-text-property
  82    (point)
  83    (progn
  84      (insert
  85       gnus-tmp-opening-bracket
  86       (format "%4d: %-20s"
  87               gnus-tmp-lines
  88               (if (> (length gnus-tmp-name) 20)
  89                   (substring gnus-tmp-name 0 20)
  90                 gnus-tmp-name))
  91       gnus-tmp-closing-bracket)
  92      (point))
  93    gnus-mouse-face-prop gnus-mouse-face)
  94   (insert " " gnus-tmp-subject-or-nil "\n"))
  95
  96 (defvar gnus-summary-line-format-spec
  97   (gnus-byte-code 'gnus-summary-line-format-spec))
  98
  99 (defun gnus-summary-dummy-line-format-spec ()
 100   (insert "*  ")
 101   (gnus-put-text-property
 102    (point)
 103    (progn
 104      (insert ":                          :")
 105      (point))
 106    gnus-mouse-face-prop gnus-mouse-face)
 107   (insert " " gnus-tmp-subject "\n"))
 108
 109 (defvar gnus-summary-dummy-line-format-spec
 110   (gnus-byte-code 'gnus-summary-dummy-line-format-spec))
 111
 112 (defun gnus-group-line-format-spec ()
 113   (insert gnus-tmp-marked-mark gnus-tmp-subscribed
 114           gnus-tmp-process-marked
 115           gnus-group-indentation
 116           (format "%5s: " gnus-tmp-number-of-unread))
 117   (gnus-put-text-property
 118    (point)
 119    (progn
 120      (insert gnus-tmp-group "\n")
 121      (1- (point)))
 122    gnus-mouse-face-prop gnus-mouse-face))
 123 (defvar gnus-group-line-format-spec
 124   (gnus-byte-code 'gnus-group-line-format-spec))
 125
 126 (defvar gnus-format-specs
 127   `((version . ,emacs-version)
 128     (gnus-version . ,(gnus-continuum-version))
 129     (group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec)
 130     (summary-dummy "*  %(:                          :%) %S\n"
 131                    ,gnus-summary-dummy-line-format-spec)
 132     (summary "%U\%R\%z\%I\%(%[%4L: %-23,23n%]%) %s\n"
 133              ,gnus-summary-line-format-spec))
 134   "Alist of format specs.")
 135
 136 (defvar gnus-article-mode-line-format-spec nil)
 137 (defvar gnus-summary-mode-line-format-spec nil)
 138 (defvar gnus-group-mode-line-format-spec nil)
 139
 140 ;;; Phew.  All that gruft is over with, fortunately.
 141
 142 ;;;###autoload
 143 (defun gnus-update-format (var)
 144   "Update the format specification near point."
 145   (interactive
 146    (list
 147     (save-excursion
 148       (eval-defun nil)
 149       ;; Find the end of the current word.
 150       (re-search-forward "[ \t\n]" nil t)
 151       ;; Search backward.
 152       (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t)
 153         (match-string 1)))))
 154   (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var)
 155                               (match-string 1 var))))
 156          (entry (assq type gnus-format-specs))
 157          value spec)
 158     (when entry
 159       (setq gnus-format-specs (delq entry gnus-format-specs)))
 160     (set
 161      (intern (format "%s-spec" var))
 162      (gnus-parse-format (setq value (symbol-value (intern var)))
 163                         (symbol-value (intern (format "%s-alist" var)))
 164                         (not (string-match "mode" var))))
 165     (setq spec (symbol-value (intern (format "%s-spec" var))))
 166     (push (list type value spec) gnus-format-specs)
 167
 168     (pop-to-buffer "*Gnus Format*")
 169     (erase-buffer)
 170     (lisp-interaction-mode)
 171     (insert (pp-to-string spec))))
 172
 173 (defun gnus-update-format-specifications (&optional force &rest types)
 174   "Update all (necessary) format specifications."
 175   ;; Make the indentation array.
 176   ;; See whether all the stored info needs to be flushed.
 177   (when (or force
 178             (not (equal (gnus-continuum-version)
 179                         (cdr (assq 'gnus-version gnus-format-specs))))
 180             (not (equal emacs-version
 181                         (cdr (assq 'version gnus-format-specs)))))
 182     (setq gnus-format-specs nil))
 183
 184   ;; Go through all the formats and see whether they need updating.
 185   (let (new-format entry type val)
 186     (while (setq type (pop types))
 187       ;; Jump to the proper buffer to find out the value of the
 188       ;; variable, if possible.  (It may be buffer-local.)
 189       (save-excursion
 190         (let ((buffer (intern (format "gnus-%s-buffer" type)))
 191               val)
 192           (when (and (boundp buffer)
 193                      (setq val (symbol-value buffer))
 194                      (gnus-buffer-exists-p val))
 195             (set-buffer val))
 196           (setq new-format (symbol-value
 197                             (intern (format "gnus-%s-line-format" type)))))
 198         (setq entry (cdr (assq type gnus-format-specs)))
 199         (if (and (car entry)
 200                  (equal (car entry) new-format))
 201             ;; Use the old format.
 202             (set (intern (format "gnus-%s-line-format-spec" type))
 203                  (cadr entry))
 204           ;; This is a new format.
 205           (setq val
 206                 (if (not (stringp new-format))
 207                     ;; This is a function call or something.
 208                     new-format
 209                   ;; This is a "real" format.
 210                   (gnus-parse-format
 211                    new-format
 212                    (symbol-value
 213                     (intern (format "gnus-%s-line-format-alist" type)))
 214                    (not (string-match "mode$" (symbol-name type))))))
 215           ;; Enter the new format spec into the list.
 216           (if entry
 217               (progn
 218                 (setcar (cdr entry) val)
 219                 (setcar entry new-format))
 220             (push (list type new-format val) gnus-format-specs))
 221           (set (intern (format "gnus-%s-line-format-spec" type)) val)))))
 222
 223   (unless (assq 'version gnus-format-specs)
 224     (push (cons 'version emacs-version) gnus-format-specs)))
 225
 226 (defvar gnus-mouse-face-0 'highlight)
 227 (defvar gnus-mouse-face-1 'highlight)
 228 (defvar gnus-mouse-face-2 'highlight)
 229 (defvar gnus-mouse-face-3 'highlight)
 230 (defvar gnus-mouse-face-4 'highlight)
 231
 232 (defun gnus-mouse-face-function (form type)
 233   `(gnus-put-text-property
 234     (point) (progn ,@form (point))
 235     gnus-mouse-face-prop
 236     ,(if (equal type 0)
 237          'gnus-mouse-face
 238        `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type)))))))
 239
 240 (defvar gnus-face-0 'bold)
 241 (defvar gnus-face-1 'italic)
 242 (defvar gnus-face-2 'bold-italic)
 243 (defvar gnus-face-3 'bold)
 244 (defvar gnus-face-4 'bold)
 245
 246 (defun gnus-face-face-function (form type)
 247   `(gnus-add-text-properties
 248     (point) (progn ,@form (point))
 249     '(gnus-face t face ,(symbol-value (intern (format "gnus-face-%d" type))))))
 250
 251 (defun gnus-balloon-face-function (form type)
 252   `(gnus-put-text-property
 253     (point) (progn ,@form (point))
 254     'balloon-help
 255     ,(intern (format "gnus-balloon-face-%d" type))))
 256
 257 (defun gnus-spec-tab (column)
 258   (if (> column 0)
 259       `(insert (make-string (max (- ,column (current-column)) 0) ? ))
 260     (let ((column (abs column)))
 261       (if gnus-use-correct-string-widths
 262           `(progn
 263              (if (> (current-column) ,column)
 264                  (while (progn
 265                           (delete-backward-char 1)
 266                           (> (current-column) ,column))))
 267              (insert (make-string (max (- ,column (current-column)) 0) ? )))
 268         `(progn
 269            (if (> (current-column) ,column)
 270                (delete-region (point)
 271                               (- (point) (- (current-column) ,column)))
 272              (insert (make-string (max (- ,column (current-column)) 0)
 273                                   ? ))))))))
 274
 275 (defun gnus-correct-length (string)
 276   "Return the correct width of STRING."
 277   (let ((length 0))
 278     (mapcar (lambda (char) (incf length (gnus-char-width char))) string)
 279     length))
 280
 281 (defun gnus-correct-substring (string start &optional end)
 282   (let ((wstart 0)
 283         (wend 0)
 284         (wseek 0)
 285         (seek 0)
 286         (length (length string))
 287         (string (concat string "\0")))
 288     ;; Find the start position.
 289     (while (and (< seek length)
 290                 (< wseek start))
 291       (incf wseek (gnus-char-width (aref string seek)))
 292       (incf seek))
 293     (setq wstart seek)
 294     ;; Find the end position.
 295     (while (and (<= seek length)
 296                 (or (not end)
 297                     (<= wseek end)))
 298       (incf wseek (gnus-char-width (aref string seek)))
 299       (incf seek))
 300     (setq wend seek)
 301     (substring string wstart (1- wend))))
 302
 303 (defun gnus-tilde-max-form (el max-width)
 304   "Return a form that limits EL to MAX-WIDTH."
 305   (let ((max (abs max-width))
 306         (length-fun (if gnus-use-correct-string-widths
 307                         'gnus-correct-length
 308                       'length))
 309         (substring-fun (if gnus-use-correct-string-widths
 310                            'gnus-correct-substring
 311                          'substring)))
 312     (if (symbolp el)
 313         `(if (> (,length-fun ,el) ,max)
 314              ,(if (< max-width 0)
 315                   `(,substring-fun ,el (- (,length-fun ,el) ,max))
 316                 `(,substring-fun ,el 0 ,max))
 317            ,el)
 318       `(let ((val (eval ,el)))
 319          (if (> (,length-fun val) ,max)
 320              ,(if (< max-width 0)
 321                   `(,substring-fun val (- (,length-fun val) ,max))
 322                 `(,substring-fun val 0 ,max))
 323            val)))))
 324
 325 (defun gnus-tilde-cut-form (el cut-width)
 326   "Return a form that cuts CUT-WIDTH off of EL."
 327   (let ((cut (abs cut-width))
 328         (length-fun (if gnus-use-correct-string-widths
 329                       'gnus-correct-length
 330                     'length))
 331         (substring-fun (if gnus-use-correct-string-widths
 332                        'gnus-correct-substring
 333                      'substring)))
 334     (if (symbolp el)
 335         `(if (> (,length-fun ,el) ,cut)
 336              ,(if (< cut-width 0)
 337                   `(,substring-fun ,el 0 (- (,length-fun ,el) ,cut))
 338                 `(,substring-fun ,el ,cut))
 339            ,el)
 340       `(let ((val (eval ,el)))
 341          (if (> (,length-fun val) ,cut)
 342              ,(if (< cut-width 0)
 343                   `(,substring-fun val 0 (- (,length-fun val) ,cut))
 344                 `(,substring-fun val ,cut))
 345            val)))))
 346
 347 (defun gnus-tilde-ignore-form (el ignore-value)
 348   "Return a form that is blank when EL is IGNORE-VALUE."
 349   (if (symbolp el)
 350       `(if (equal ,el ,ignore-value)
 351            "" ,el)
 352     `(let ((val (eval ,el)))
 353        (if (equal val ,ignore-value)
 354            "" val))))
 355
 356 (defun gnus-pad-form (el pad-width)
 357   "Return a form that pads EL to PAD-WIDTH accounting for multi-column
 358 characters correctly. This is because `format' may pad to columns or to
 359 characters when given a pad value."
 360   (let ((pad (abs pad-width))
 361         (side (< 0 pad-width)))
 362     (if (symbolp el)
 363         `(let ((need (- ,pad (,(if gnus-use-correct-string-widths
 364                                    'gnus-correct-length
 365                                  'length)
 366                               ,el))))
 367            (if (> need 0)
 368                (concat ,(when side '(make-string need ?\ ))
 369                        ,el
 370                        ,(when (not side) '(make-string need ?\ )))
 371              ,el))
 372       `(let* ((val (eval ,el))
 373               (need (- ,pad (,(if gnus-use-correct-string-widths
 374                                   'gnus-correct-length
 375                                 'length) val))))
 376          (if (> need 0)
 377              (concat ,(when side '(make-string need ?\ ))
 378                      val
 379                      ,(when (not side) '(make-string need ?\ )))
 380            val)))))
 381
 382 (defun gnus-parse-format (format spec-alist &optional insert)
 383   ;; This function parses the FORMAT string with the help of the
 384   ;; SPEC-ALIST and returns a list that can be eval'ed to return the
 385   ;; string.  If the FORMAT string contains the specifiers %( and %)
 386   ;; the text between them will have the mouse-face text property.
 387   ;; If the FORMAT string contains the specifiers %[ and %], the text between
 388   ;; them will have the balloon-help text property.
 389   (let ((case-fold-search nil))
 390     (if (string-match
 391          "\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'\\|%[-0-9]*="
 392          format)
 393         (gnus-parse-complex-format format spec-alist)
 394       ;; This is a simple format.
 395       (gnus-parse-simple-format format spec-alist insert))))
 396
 397 (defun gnus-parse-complex-format (format spec-alist)
 398   (let (found-C)
 399     (save-excursion
 400       (gnus-set-work-buffer)
 401       (insert format)
 402       (goto-char (point-min))
 403       (while (re-search-forward "\"" nil t)
 404         (replace-match "\\\"" nil t))
 405       (goto-char (point-min))
 406       (insert "(\"")
 407       ;; Convert all font specs into font spec lists.
 408       (while (re-search-forward "%\\([0-9]+\\)?\\([«»{}()]\\)" nil t)
 409         (let ((number (if (match-beginning 1)
 410                           (match-string 1) "0"))
 411               (delim (aref (match-string 2) 0)))
 412           (if (or (= delim ?\()
 413                   (= delim ?\{)
 414                   (= delim ?\«))
 415               (replace-match (concat "\"("
 416                                      (cond ((= delim ?\() "mouse")
 417                                            ((= delim ?\{) "face")
 418                                            (t "balloon"))
 419                                      " " number " \"")
 420                              t t)
 421             (replace-match "\")\""))))
 422       (goto-char (point-max))
 423       (insert "\")")
 424       ;; Convert point position commands.
 425       (goto-char (point-min))
 426       (let ((case-fold-search nil))
 427         (while (re-search-forward "%\\([-0-9]+\\)?C" nil t)
 428           (replace-match "\"(point)\"" t t)
 429           (setq found-C t)))
 430       ;; Convert TAB commands.
 431       (goto-char (point-min))
 432       (while (re-search-forward "%\\([-0-9]+\\)=" nil t)
 433         (replace-match (format "\"(tab %s)\"" (match-string 1)) t t))
 434       ;; Convert the buffer into the spec.
 435       (goto-char (point-min))
 436       (let ((form (read (current-buffer))))
 437         (if found-C
 438             `(let (gnus-position)
 439                ,@(gnus-complex-form-to-spec form spec-alist)
 440                (if gnus-position
 441                    (gnus-put-text-property gnus-position (1+ gnus-position)
 442                                            'gnus-position t)))
 443           `(progn
 444              ,@(gnus-complex-form-to-spec form spec-alist)))))))
 445
 446 (defun gnus-complex-form-to-spec (form spec-alist)
 447   (delq nil
 448         (mapcar
 449          (lambda (sform)
 450            (cond
 451             ((stringp sform)
 452              (gnus-parse-simple-format sform spec-alist t))
 453             ((eq (car sform) 'point)
 454              '(setq gnus-position (point)))
 455             ((eq (car sform) 'tab)
 456              (gnus-spec-tab (cadr sform)))
 457             (t
 458              (funcall (intern (format "gnus-%s-face-function" (car sform)))
 459                       (gnus-complex-form-to-spec (cddr sform) spec-alist)
 460                       (nth 1 sform)))))
 461          form)))
 462
 463 (defun gnus-parse-simple-format (format spec-alist &optional insert)
 464   ;; This function parses the FORMAT string with the help of the
 465   ;; SPEC-ALIST and returns a list that can be eval'ed to return a
 466   ;; string.
 467   (let ((max-width 0)
 468         spec flist fstring elem result dontinsert user-defined
 469         type value pad-width spec-beg cut-width ignore-value
 470         tilde-form tilde elem-type extended-spec)
 471     (save-excursion
 472       (gnus-set-work-buffer)
 473       (insert format)
 474       (goto-char (point-min))
 475       (while (re-search-forward "%" nil t)
 476         (setq user-defined nil
 477               spec-beg nil
 478               pad-width nil
 479               max-width nil
 480               cut-width nil
 481               ignore-value nil
 482               tilde-form nil
 483               extended-spec nil)
 484         (setq spec-beg (1- (point)))
 485
 486         ;; Parse this spec fully.
 487         (while
 488             (cond
 489              ((looking-at "\\([-.0-9]+\\)\\(,[-0-9]+\\)?")
 490               (setq pad-width (string-to-number (match-string 1)))
 491               (when (match-beginning 2)
 492                 (setq max-width (string-to-number (buffer-substring
 493                                                    (1+ (match-beginning 2))
 494                                                    (match-end 2)))))
 495               (goto-char (match-end 0)))
 496              ((looking-at "~")
 497               (forward-char 1)
 498               (setq tilde (read (current-buffer))
 499                     type (car tilde)
 500                     value (cadr tilde))
 501               (cond
 502                ((memq type '(pad pad-left))
 503                 (setq pad-width value))
 504                ((eq type 'pad-right)
 505                 (setq pad-width (- value)))
 506                ((memq type '(max-right max))
 507                 (setq max-width value))
 508                ((eq type 'max-left)
 509                 (setq max-width (- value)))
 510                ((memq type '(cut cut-left))
 511                 (setq cut-width value))
 512                ((eq type 'cut-right)
 513                 (setq cut-width (- value)))
 514                ((eq type 'ignore)
 515                 (setq ignore-value
 516                       (if (stringp value) value (format "%s" value))))
 517                ((eq type 'form)
 518                 (setq tilde-form value))
 519                (t
 520                 (error "Unknown tilde type: %s" tilde)))
 521               t)
 522              (t
 523               nil)))
 524         (cond
 525          ;; User-defined spec -- find the spec name.
 526          ((eq (setq spec (char-after)) ?u)
 527           (forward-char 1)
 528           (when (and (eq (setq user-defined (char-after)) ?&)
 529                      (looking-at "&\\([^;]+\\);"))
 530             (setq user-defined (match-string 1))
 531             (goto-char (match-end 1))))
 532          ;; extended spec
 533          ((and (eq spec ?&) (looking-at "&\\([^;]+\\);"))
 534           (setq extended-spec (intern (match-string 1)))
 535           (goto-char (match-end 1))))
 536         (forward-char 1)
 537         (delete-region spec-beg (point))
 538
 539         ;; Now we have all the relevant data on this spec, so
 540         ;; we start doing stuff.
 541         (insert "%")
 542         (if (eq spec ?%)
 543             ;; "%%" just results in a "%".
 544             (insert "%")
 545           (cond
 546            ;; Do tilde forms.
 547            ((eq spec ?@)
 548             (setq elem (list tilde-form ?s)))
 549            ;; Treat user defined format specifiers specially.
 550            (user-defined
 551             (setq elem
 552                   (list
 553                    (list (intern (format
 554                                   (if (stringp user-defined)
 555                                       "gnus-user-format-function-%s"
 556                                     "gnus-user-format-function-%c")
 557                                   user-defined))
 558                          'gnus-tmp-header)
 559                    ?s)))
 560            ;; Find the specification from `spec-alist'.
 561            ((setq elem (cdr (assq (or extended-spec spec) spec-alist))))
 562            (t
 563             (setq elem '("*" ?s))))
 564           (setq elem-type (cadr elem))
 565           ;; Insert the new format elements.
 566           (when (and pad-width
 567                      (not (and (featurep 'xemacs)
 568                                gnus-use-correct-string-widths)))
 569             (insert (number-to-string pad-width)))
 570           ;; Create the form to be evaled.
 571           (if (or max-width cut-width ignore-value
 572                   (and (featurep 'xemacs)
 573                        gnus-use-correct-string-widths))
 574               (progn
 575                 (insert ?s)
 576                 (let ((el (car elem)))
 577                   (cond ((= (cadr elem) ?c)
 578                          (setq el (list 'char-to-string el)))
 579                         ((= (cadr elem) ?d)
 580                          (setq el (list 'int-to-string el))))
 581                   (when ignore-value
 582                     (setq el (gnus-tilde-ignore-form el ignore-value)))
 583                   (when cut-width
 584                     (setq el (gnus-tilde-cut-form el cut-width)))
 585                   (when max-width
 586                     (setq el (gnus-tilde-max-form el max-width)))
 587                   (when pad-width
 588                     (setq el (gnus-pad-form el pad-width)))
 589                   (push el flist)))
 590             (insert elem-type)
 591             (push (car elem) flist))))
 592       (setq fstring (buffer-substring-no-properties (point-min) (point-max))))
 593
 594     ;; Do some postprocessing to increase efficiency.
 595     (setq
 596      result
 597      (cond
 598       ;; Emptiness.
 599       ((string= fstring "")
 600        nil)
 601       ;; Not a format string.
 602       ((not (string-match "%" fstring))
 603        (list fstring))
 604       ;; A format string with just a single string spec.
 605       ((string= fstring "%s")
 606        (list (car flist)))
 607       ;; A single character.
 608       ((string= fstring "%c")
 609        (list (car flist)))
 610       ;; A single number.
 611       ((string= fstring "%d")
 612        (setq dontinsert)
 613        (if insert
 614            (list `(princ ,(car flist)))
 615          (list `(int-to-string ,(car flist)))))
 616       ;; Just lots of chars and strings.
 617       ((string-match "\\`\\(%[cs]\\)+\\'" fstring)
 618        (nreverse flist))
 619       ;; A single string spec at the beginning of the spec.
 620    &nbs