cgit.sxemacs.org Git - packages/blob - xemacs-packages/vm/lisp/vm-version.el

   1 ;;; vm-version.el --- Version information about VM and the Emacs running VM.
   2 ;;
   3 ;; Copyright (C) Kyle E. Jones, Robert Widhopf-Fenk
   4 ;; Copyright (C) 2003-2007 Robert Widhopf-Fenk
   5 ;;
   6 ;; This program is free software; you can redistribute it and/or modify
   7 ;; it under the terms of the GNU General Public License as published by
   8 ;; the Free Software Foundation; either version 2 of the License, or
   9 ;; (at your option) any later version.
  10 ;;
  11 ;; This program is distributed in the hope that it will be useful,
  12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;; GNU General Public License for more details.
  15 ;;
  16 ;; You should have received a copy of the GNU General Public License along
  17 ;; with this program; if not, write to the Free Software Foundation, Inc.,
  18 ;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 ;;; Code:
  21 (defvar vm-version nil
  22   "Version number of VM.
  23 Call `vm-version' instead of accessing this variable!")
  24
  25 (defvar vm-version-info nil
  26   "The exact version information for tarbundles.")
  27
  28 (defun vm-version ()
  29   "Return the value of the variable `vm-version'."
  30   (interactive)
  31   (unless vm-version
  32     (save-excursion
  33       (set-buffer (get-buffer-create " *vm-version*"))
  34       (let* ((f (locate-library "vm"))
  35              (d (file-name-directory f))
  36              (b (get-buffer " *vm-version*"))
  37              (bzrdir (expand-file-name ".bzr" (concat d "../")))
  38              (bzr (and (file-exists-p bzrdir)
  39                        (if (functionp 'locate-file)
  40                            (or (locate-file "bzr.exe" exec-path)
  41                                (locate-file "bzr.bat" exec-path)
  42                                (locate-file "bzr" exec-path))
  43                          "bzr"))))
  44         (setq default-directory d)
  45         (erase-buffer)
  46         (cond ((and bzr
  47                     (condition-case nil
  48                         (= 0 (call-process bzr nil b))
  49                       (error nil)))
  50                (erase-buffer)
  51                ;; get the current branch nick and revno from bzr
  52                (call-process bzr nil b nil "--no-aliases" "--no-plugins" "nick")
  53                (insert "-")
  54                (call-process bzr nil b nil "--no-aliases" "--no-plugins" "revno"))
  55               ((and (not bzr)
  56                     (locate-library "vm-revno")
  57                     (load-library "vm-revno"))
  58                (insert vm-version))
  59               (t
  60                (insert "?bug?")
  61                (message "ERROR: Cannot determine VM version!")
  62                (sit-for 5)))
  63         (goto-char (point-min))
  64         (if (looking-at "vm-")
  65             (replace-match ""))
  66         ;; remove any whitespace
  67         (while (re-search-forward "[\n\t\r ]+" (point-max) t)
  68           (replace-match "")))
  69       (setq vm-version (buffer-substring (point-min) (point-max)))))
  70   vm-version)
  71
  72 (defconst vm-xemacs-p
  73   (featurep 'xemacs))
  74 (defconst vm-xemacs-mule-p
  75   (and vm-xemacs-p (featurep 'mule)))
  76 (defconst vm-xemacs-file-coding-p
  77   (and vm-xemacs-p (featurep 'file-coding)
  78        ;; paranoia
  79        (fboundp
  80         'set-buffer-file-coding-system)))
  81 (defconst vm-fsfemacs-p
  82   (not vm-xemacs-p))
  83 (defconst vm-fsfemacs-mule-p
  84   (and (not vm-xemacs-mule-p) (featurep 'mule)
  85        (fboundp 'set-buffer-file-coding-system)))
  86
  87 (defun vm-xemacs-p () vm-xemacs-p)
  88 (defun vm-xemacs-mule-p () vm-xemacs-mule-p)
  89 (defun vm-xemacs-file-coding-p () vm-xemacs-file-coding-p)
  90 (defun vm-fsfemacs-p () vm-fsfemacs-p)
  91 (defun vm-fsfemacs-mule-p () vm-fsfemacs-mule-p)
  92
  93 (defun vm-mouse-fsfemacs-mouse-p ()
  94   (and vm-fsfemacs-p
  95        (fboundp 'set-mouse-position)))
  96
  97 (defun vm-mouse-xemacs-mouse-p ()
  98   (and vm-xemacs-p
  99        (fboundp 'set-mouse-position)))
 100
 101 (defun vm-menu-fsfemacs-menus-p ()
 102   (and vm-fsfemacs-p
 103        (fboundp 'menu-bar-mode)))
 104
 105 (defun vm-menu-fsfemacs19-menus-p ()
 106   (and vm-fsfemacs-p
 107        (fboundp 'menu-bar-mode)
 108        (= emacs-major-version 19)))
 109
 110 (defun vm-menu-xemacs-menus-p ()
 111   (and vm-xemacs-p
 112        (fboundp 'set-buffer-menubar)))
 113
 114 (defun vm-menu-can-eval-item-name ()
 115   (and vm-xemacs-p
 116        (fboundp 'check-menu-syntax)
 117        (condition-case nil
 118            (check-menu-syntax '("bar" ((identity "foo") 'ding t)))
 119          (error nil))))
 120
 121 (defun vm-multiple-frames-possible-p ()
 122   (cond (vm-xemacs-p
 123          (or (memq 'win (device-matching-specifier-tag-list))
 124              (featurep 'tty-frames)))
 125         (vm-fsfemacs-p
 126          (fboundp 'make-frame))))
 127
 128 (defun vm-mouse-support-possible-p ()
 129   (cond (vm-xemacs-p
 130          (featurep 'window-system))
 131         (vm-fsfemacs-p
 132          (fboundp 'track-mouse))))
 133
 134 (defun vm-mouse-support-possible-here-p ()
 135   (cond (vm-xemacs-p
 136          (memq 'win (device-matching-specifier-tag-list)))
 137         (vm-fsfemacs-p
 138          (memq window-system '(x mac w32 win32)))))
 139
 140 (defun vm-menu-support-possible-p ()
 141   (cond (vm-xemacs-p
 142          (featurep 'menubar))
 143         (vm-fsfemacs-p
 144          (fboundp 'menu-bar-mode))))
 145
 146 (defun vm-toolbar-support-possible-p ()
 147   (or (and vm-xemacs-p (featurep 'toolbar))
 148       (and vm-fsfemacs-p (fboundp 'tool-bar-mode) (boundp 'tool-bar-map))))
 149
 150 (defun vm-multiple-fonts-possible-p ()
 151   (cond (vm-xemacs-p
 152          (memq (device-type) '(x gtk mswindows)))
 153         (vm-fsfemacs-p
 154          (memq window-system '(x mac w32 win32)))))
 155
 156 (defun vm-images-possible-here-p ()
 157   (or (and vm-xemacs-p (memq (device-type) '(x gtk mswindows)))
 158       (and vm-fsfemacs-p window-system
 159            (or (fboundp 'image-type-available-p)
 160                (and (stringp vm-imagemagick-convert-program)
 161                     (stringp vm-imagemagick-identify-program))))))
 162
 163 (defun vm-image-type-available-p (type)
 164   (if (fboundp 'image-type-available-p)
 165       (image-type-available-p type)
 166     (or (featurep type) (eq type 'xbm))))
 167
 168 (provide 'vm-version)
 169
 170 ;;; vm-version.el ends here