lisp/gnus/gnus-spec.el

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