* wl-version.el (wl-generate-user-agent-string-1): Use `cond'
[elisp/wanderlust.git] / wl / wl-version.el
1 ;;; wl-version.el -- Version information for Wanderlust.
2
3 ;; Copyright 2000 Yuuichi Teranishi <teranisi@gohome.org>
4
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Keywords: mail, net news
7
8 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
9
10 ;; This program 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 ;; This program 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
26 ;;; Commentary:
27 ;;
28
29 ;;; Code:
30 ;;
31 (require 'product)
32 (provide 'wl-version)                   ; have to declare in the top.
33
34 (product-provide 'wl-version
35   (product-define
36    "Wanderlust" nil
37    (eval-when-compile
38      (require 'elmo-version)
39      (product-version (product-find 'elmo-version))) ; equals to ELMO version.
40    "Roam"))
41
42 ;; set version-string
43 (if (fboundp 'product-version-as-string)
44     (product-version-as-string 'wl-version)
45   (product-string-1 'wl-version))       ; APEL 10.2 or earlier
46
47 ;; require wl-util after product-provide.
48 (eval-when-compile (require 'wl-util))  ; wl-match-string
49
50 (defun wl-version (&optional with-codename)
51   "Return Wanderlust version.
52 If WITH-CODENAME add codename."
53   (product-string-1 'wl-version with-codename))
54
55 (defun wl-version-show (&optional arg)
56   "Print Wanderlust version.
57 If ARG insert string at point."
58   (interactive "P")
59   (if arg
60       (insert (message "%s" (wl-version t)))
61     (message "%s" (wl-version t))))
62
63 (defvar wl-version-status-alist
64   '(((eq (% (nth 1 (product-version (product-find 'wl-version))) 2) 0)
65      . "stable")
66     (t . "beta"))
67   "An alist to define the version status.")
68
69 (defun wl-version-status ()
70   "Return version status (\"stable\" or \"beta\")."
71   (let ((salist wl-version-status-alist)
72         status)
73     (while salist
74       (when (eval (car (car salist)))
75         (setq status (cdr (car salist)))
76         (setq salist nil))
77       (setq salist (cdr salist)))
78     status))
79
80 ;; compile warning
81 (defvar mule-version)
82 (defvar nemacs-version)
83 (defvar emacs-beta-version)
84 (defvar xemacs-codename)
85 (defvar mime-edit-insert-user-agent-field)
86 (defvar mime-edit-user-agent-value)
87 (defvar mime-editor/version)
88 (defvar mime-editor/codename)
89
90 (defun wl-generate-user-agent-string ()
91   "A candidate of `wl-generate-mailer-string-func'.
92 Insert User-Agent field instead of X-Mailer field."
93   (concat "User-Agent: "
94           (wl-generate-user-agent-string-1
95            (or (and (boundp 'mime-edit-insert-user-agent-field)
96                     mime-edit-insert-user-agent-field)
97                (and (boundp 'mime-editor/version)
98                     mime-editor/version)))))
99
100 (defun wl-generate-user-agent-string-1 (&optional verbose)
101   "Return User-Agent field value.
102 If VERBOSE return with SEMI, FLIM and APEL version"
103   (cond
104    ;; Don't use product-string-verbose for short User-Agent field value.
105    ((not verbose)
106     (concat (product-string-1 'wl-version t) " "
107             (wl-extended-emacs-version3 "/" t)))
108    ;; SEMI
109    ((and (boundp 'mime-edit-user-agent-value) mime-edit-user-agent-value)
110     (concat (product-string-verbose 'wl-version) " "
111             mime-edit-user-agent-value))
112    ;; tm
113    ((and (boundp 'mime-editor/version) mime-editor/version)
114     (concat (product-string-verbose 'wl-version) " "
115             "tm/" mime-editor/version
116             (if (and (boundp 'mime-editor/codename)
117                      mime-editor/codename)
118                 (concat " (" mime-editor/codename ")"))
119             (if (and (boundp 'mime-library-product)
120                      mime-library-product)
121                 (concat " " (aref mime-library-product 0)
122                         "/"
123                         (mapconcat 'int-to-string
124                                    (aref mime-library-product 1)
125                                    ".")
126                         " (" (aref mime-library-product 2) ")"))
127             (condition-case nil
128                 (progn
129                   (require 'apel-ver)
130                   (concat " " (apel-version)))
131               (file-error nil))
132             " " (wl-extended-emacs-version3 "/" t)))
133    ;; error case
134    (t
135     (product-string-1 'wl-version nil))))
136
137 ;; from gnus
138 (defun wl-extended-emacs-version (&optional with-codename)
139   "Stringified Emacs version.
140 If WITH-CODENAME add XEmacs codename."
141   (cond
142    ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version)
143     (concat "Emacs " (wl-match-string 1 emacs-version)
144             (and (boundp 'mule-version)(concat "/Mule " mule-version))))
145    ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
146                   emacs-version)
147     (concat (wl-match-string 1 emacs-version)
148             (format " %d.%d" emacs-major-version emacs-minor-version)
149             (if (and (boundp 'emacs-beta-version)
150                      emacs-beta-version)
151                 (format "b%d" emacs-beta-version))
152             (if with-codename
153                 (if (boundp 'xemacs-codename)
154                     (concat " - \"" xemacs-codename "\"")))))
155    (t emacs-version)))
156
157 (defun wl-extended-emacs-version2 (&optional delimiter with-codename)
158   "Stringified Emacs version.
159 Separate DELIMITER (default it \" \").  If WITH-CODENAME add XEmacs codename."
160   (cond
161    ((and (boundp 'mule-version)
162          mule-version
163          (string-match "\\([0-9]+\.[0-9]+\\)\\(.*$\\)" mule-version))
164     (format "Mule%s%s@%d.%d%s"
165             (or delimiter " ")
166             (wl-match-string 1 mule-version)
167             emacs-major-version
168             emacs-minor-version
169             (if with-codename
170                 (wl-match-string 2 mule-version)
171               "")))
172    ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version)
173     (if (boundp 'nemacs-version)
174         (concat "Nemacs" (or delimiter " ")
175                 nemacs-version
176                 "@"
177                 (substring emacs-version
178                            (match-beginning 1)
179                            (match-end 1)))
180       (concat "Emacs" (or delimiter " ")
181               (wl-match-string 1 emacs-version))))
182    ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
183                   emacs-version)
184     (concat (wl-match-string 1 emacs-version)
185             (or delimiter " ")
186             (format "%d.%d" emacs-major-version emacs-minor-version)
187             (if (and (boundp 'emacs-beta-version)
188                      emacs-beta-version)
189                 (format "b%d" emacs-beta-version))
190             (if (and with-codename
191                      (boundp 'xemacs-codename)
192                      xemacs-codename)
193                 (format " (%s)" xemacs-codename))))
194    (t emacs-version)))
195
196 (defun wl-extended-emacs-version3 (&optional delimiter with-codename)
197   "Stringified Emacs version.
198 Separate DELIMITER (default it \" \").  If WITH-CODENAME add XEmacs codename."
199   (cond
200    ((and (boundp 'mule-version)
201          mule-version
202          (string-match "\\([0-9]+\.[0-9]+\\)\\(.*$\\)" mule-version))
203     (format "Emacs%s%d.%d Mule%s%s%s"
204             (or delimiter " ")
205             emacs-major-version
206             emacs-minor-version
207             (or delimiter " ")
208             (wl-match-string 1 mule-version)
209             (if with-codename
210                 (wl-match-string 2 mule-version)
211               "")))
212    ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version)
213     (if (boundp 'nemacs-version)
214         (let ((nemacs-codename-assoc '(("3.3.2" . " (FUJIMUSUME)")
215                                        ("3.3.1" . " (HINAMATSURI)")
216                                        ("3.2.3" . " (YUMENO-AWAYUKI)"))))
217           (format "Emacs%s%s Nemacs%s%s%s"
218                   (or delimiter " ")
219                   (wl-match-string 1 emacs-version)
220                   (or delimiter " ")
221                   nemacs-version
222                   (or (and with-codename
223                            (cdr (assoc nemacs-version
224                                        nemacs-codename-assoc)))
225                       "")))
226       (concat "Emacs" (or delimiter " ")
227               (wl-match-string 1 emacs-version))))
228    ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
229                   emacs-version)
230     (concat (wl-match-string 1 emacs-version)
231             (or delimiter " ")
232             (format "%d.%d" emacs-major-version emacs-minor-version)
233             (if (and (boundp 'emacs-beta-version)
234                      emacs-beta-version)
235                 (format "b%d" emacs-beta-version))
236             (if (and with-codename
237                      (boundp 'xemacs-codename)
238                      xemacs-codename)
239                 (format " (%s)" xemacs-codename))))
240    (t emacs-version)))
241
242
243 ;; for backward compatibility
244 (defconst wl-appname (product-name (product-find 'wl-version)))
245 (make-obsolete-variable
246  'wl-appname
247  "use (product-name (product-find 'wl-version)) insteaed.")
248
249 (defconst wl-version (product-version-string (product-find 'wl-version)))
250 (make-obsolete-variable
251  'wl-version
252  "use (product-version-string (product-find 'wl-version)) instead.")
253
254 (defconst wl-codename (product-code-name (product-find 'wl-version)))
255 (make-obsolete-variable
256  'wl-codename
257  "use (product-code-name (product-find 'wl-version)) instead.")
258
259 ;;; wl-version.el ends here