home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / utils / sysdep.el < prev    next >
Encoding:
Text File  |  1995-06-16  |  12.6 KB  |  294 lines
  1. ;;; sysdep.el --- consolidate Emacs-version dependencies in one file.
  2.  
  3. ;; Copyright (C) 1995 Ben Wing.
  4.  
  5. ;; Author: Ben Wing <wing@netcom.com>
  6. ;; Keywords: lisp, tools
  7. ;; Version: 0.001
  8.  
  9. ;; The purpose of this file is to eliminate the cruftiness that
  10. ;; would otherwise be required of packages that want to run on multiple
  11. ;; versions of Emacs.  The idea is that we make it look like we're running
  12. ;; the latest version of XEmacs (currently 19.12) by emulating all the
  13. ;; missing functions.
  14.  
  15. ;; #### This file does not currently do any advising but should.
  16. ;; Unfortunately, advice.el is a hugely big package.  Is any such
  17. ;; thing as `advice-lite' possible?
  18.  
  19. ;; #### - This package is great, but its role needs to be thought out a bit
  20. ;; more.  Sysdep will not permit programs written for the old XEmacs API to
  21. ;; run on new versions of XEmacs.  Sysdep is a backward-compatibility
  22. ;; package for the latest and greatest XEmacs API.  It permits programmers
  23. ;; to use the latest XEmacs functionality and still have their programs run
  24. ;; on older versions of XEmacs...perhaps even on FSF Emacs.  It should NEVER
  25. ;; ever need to be loaded in the newest XEmacs.  It doesn't even make sense
  26. ;; to put it in the lisp/utils part of the XEmacs distribution because its
  27. ;; real purpose is to be distributed with packages like w3 which take
  28. ;; advantage of the latest and greatest features of XEmacs but still need to
  29. ;; be run on older versions.  --Stig
  30.  
  31. ;; Any packages that wish to use this file should load it using
  32. ;; `load-library'.  It will not load itself if a version of sysdep.el
  33. ;; that is at least as recent has already been loaded, but will
  34. ;; load over an older version of sysdep.el.  It will attempt to
  35. ;; not redefine functions that have already been custom-redefined,
  36. ;; but will redefine a function if the supplied definition came from
  37. ;; an older version of sysdep.el.
  38.  
  39. ;; Packages such as w3 that wish to include this file with the package
  40. ;; should rename it to something unique, such as `w3-sysdep.el', and
  41. ;; load it with `load-library'.  That will ensure that no conflicts
  42. ;; arise if more than one package in the load path provides a version
  43. ;; of sysdep.el.  If multiple packages load sysdep.el, the most recent
  44. ;; version will end up loaded; as long as I'm careful not to
  45. ;; introduce bugs in previously working definitions, this should work
  46. ;; fine.
  47.  
  48. ;; You may well discover deficiencies in this file as you use it.
  49. ;; The preferable way of dealing with this is to send me a patch
  50. ;; to sysdep.el; that way, the collective body of knowledge gets
  51. ;; increased.
  52.  
  53. ;; DO NOT load this file with `require'.
  54. ;; DO NOT put a `provide' statement in this file.
  55.  
  56. ;; IMPORTANT: leave the version string in the format X.XXX (e.g. 1.001)
  57. ;; so that string comparisons to other versions work properly.
  58.  
  59. (defconst sysdep-potential-version "0.001")
  60.  
  61. (if (and (boundp 'sysdep-version)
  62.      (not (string-lessp sysdep-version sysdep-potential-version)))
  63.     ;; if a more recent version of sysdep was already loaded,
  64.     ;; or if the same package is loaded again, don't load.
  65.     nil
  66.  
  67. (defconst sysdep-version sysdep-potential-version)
  68.  
  69. ;; this macro means: define the function, but only if either it
  70. ;; wasn't bound before, or the supplied binding comes from an older
  71. ;; version of sysdep.el.  That way, user-supplied bindings don't
  72. ;; get overridden.
  73.  
  74. ;; note: sysdep-defalias is often more useful than this function,
  75. ;; esp. since you can do load-time conditionalizing and can
  76. ;; optionally leave the function undefined. (e.g. frame functions
  77. ;; in v18.)
  78.  
  79. (defmacro sysdep-defun (function &rest everything-else)
  80.   (` (cond ((or (not (fboundp (quote (, function))))
  81.         (get (quote (, function)) 'sysdep-defined-this))
  82.         (put (quote (, function)) 'sysdep-defined-this t)
  83.         (defun (, function) (,@ everything-else))))))
  84.  
  85. (defmacro sysdep-defvar (function &rest everything-else)
  86.   (` (cond ((or (not (boundp (quote (, function))))
  87.         (get (quote (, function)) 'sysdep-defined-this))
  88.         (put (quote (, function)) 'sysdep-defined-this t)
  89.         (defvar (, function) (,@ everything-else))))))
  90.  
  91. (defmacro sysdep-defconst (function &rest everything-else)
  92.   (` (cond ((or (not (boundp (quote (, function))))
  93.         (get (quote (, function)) 'sysdep-defined-this))
  94.         (put (quote (, function)) 'sysdep-defined-this t)
  95.         (defconst (, function) (,@ everything-else))))))
  96.  
  97. ;; similar for fset and defalias.  No need to quote as the argument
  98. ;; is already quoted.
  99.  
  100. (defmacro sysdep-fset (function def)
  101.   (` (cond ((and (or (not (fboundp (, function)))
  102.              (get (, function) 'sysdep-defined-this))
  103.          (, def))
  104.         (put (, function) 'sysdep-defined-this t)
  105.         (fset (, function) (, def))))))
  106.  
  107. (defmacro sysdep-defalias (function def)
  108.   (` (cond ((and (or (not (fboundp (, function)))
  109.              (get (, function) 'sysdep-defined-this))
  110.          (, def))
  111.         (put (, function) 'sysdep-defined-this t)
  112.         (defalias (, function) (, def))))))
  113.  
  114. ;; bootstrapping: defalias and define-function don't exist
  115. ;; in older versions of lemacs
  116.  
  117. (sysdep-fset 'defalias 'fset)
  118. (sysdep-defalias 'define-function 'defalias)
  119.  
  120. ;; useful ways of determining what version is running
  121. ;; emacs-major-version and emacs-minor-version are
  122. ;; already defined in recent versions of FSF Emacs and XEmacs
  123.  
  124. (sysdep-defconst emacs-major-version
  125.          ;; will string-match ever fail?  If so, assume 19.0.
  126.          ;; (should we assume 18.something?)
  127.          (if (string-match "^[0-9]+" emacs-version)
  128.              (string-to-int
  129.               (substring emacs-version
  130.                  (match-beginning 0) (match-end 0)))
  131.            19))
  132.  
  133. (sysdep-defconst emacs-minor-version
  134.          (if (string-match "^[0-9]+\\.\\([0-9]+\\)" emacs-version)
  135.              (string-to-int
  136.               (substring emacs-version
  137.                  (match-beginning 1) (match-end 1)))
  138.            0))
  139.  
  140. (sysdep-defconst sysdep-running-xemacs
  141.          (or (string-match "Lucid" emacs-version)
  142.              (string-match "XEmacs" emacs-version)))
  143.  
  144. (sysdep-defconst window-system nil)
  145. (sysdep-defconst window-system-version 0)
  146.  
  147. ;; frame-related stuff.
  148.  
  149. (sysdep-defalias 'buffer-dedicated-frame 'buffer-dedicated-screen)
  150. (sysdep-defalias 'deiconify-frame
  151.   (cond ((fboundp 'deiconify-screen) 'deiconify-screen)
  152.     ;; make-frame-visible will be defined as necessary
  153.     (t 'make-frame-visible)))
  154. (sysdep-defalias 'delete-frame 'delete-screen)
  155. (sysdep-defalias 'event-frame 'event-screen)
  156. (sysdep-defalias 'event-glyph-extent 'event-glyph)
  157. (sysdep-defalias 'find-file-other-frame 'find-file-other-screen)
  158. (sysdep-defalias 'find-file-read-only-other-frame
  159.   'find-file-read-only-other-screen)
  160. (sysdep-defalias 'frame-height 'screen-height)
  161. (sysdep-defalias 'frame-iconified-p 'screen-iconified-p)
  162. (sysdep-defalias 'frame-left-margin-width 'screen-left-margin-width)
  163. (sysdep-defalias 'frame-list 'screen-list)
  164. (sysdep-defalias 'frame-live-p
  165.   (cond ((fboundp 'screen-live-p) 'screen-live-p)
  166.     ((fboundp 'live-screen-p) 'live-screen-p)
  167.     ;; #### not sure if this is correct (this is for Epoch)
  168.     ;; but gnuserv.el uses it this way
  169.     ((fboundp 'screenp) 'screenp)))
  170. (sysdep-defalias 'frame-name 'screen-name)
  171. (sysdep-defalias 'frame-parameters 'screen-parameters)
  172. (sysdep-defalias 'frame-pixel-height 'screen-pixel-height)
  173. (sysdep-defalias 'frame-pixel-width 'screen-pixel-width)
  174. (sysdep-defalias 'frame-right-margin-width 'screen-right-margin-width)
  175. (sysdep-defalias 'frame-root-window 'screen-root-window)
  176. (sysdep-defalias 'frame-selected-window 'screen-selected-window)
  177. (sysdep-defalias 'frame-totally-visible-p 'screen-totally-visible-p)
  178. (sysdep-defalias 'frame-visible-p 'screen-visible-p)
  179. (sysdep-defalias 'frame-width 'screen-width)
  180. (sysdep-defalias 'framep 'screenp)
  181. (sysdep-defalias 'get-frame-for-buffer 'get-screen-for-buffer)
  182. (sysdep-defalias 'get-frame-for-buffer-noselect 'get-screen-for-buffer-noselect)
  183. (sysdep-defalias 'get-other-frame 'get-other-screen)
  184. (sysdep-defalias 'iconify-frame 'iconify-screen)
  185. (sysdep-defalias 'lower-frame 'lower-screen)
  186. (sysdep-defalias 'mail-other-frame 'mail-other-screen)
  187.  
  188. (sysdep-defalias 'make-frame
  189.   (cond ((fboundp 'make-screen)
  190.      (function (lambda (&optional parameters device)
  191.              (make-screen parameters))))
  192.     ((fboundp 'x-create-screen)
  193.      (function (lambda (&optional parameters device)
  194.              (x-create-screen parameters))))))
  195.  
  196. (sysdep-defalias 'make-frame-invisible 'make-screen-invisible)
  197. (sysdep-defalias 'make-frame-visible
  198.   (cond ((fboundp 'make-screen-visible) 'make-screen-visible)
  199.     ((fboundp 'mapraised-screen) 'mapraised-screen)
  200.     ((fboundp 'x-remap-window)
  201.      (lambda (&optional x)
  202.        (x-remap-window)
  203.        (accept-process-output)))))
  204. (sysdep-defalias 'modify-frame-parameters 'modify-screen-parameters)
  205. (sysdep-defalias 'new-frame 'new-screen)
  206. (sysdep-defalias 'next-frame 'next-screen)
  207. (sysdep-defalias 'next-multiframe-window 'next-multiscreen-window)
  208. (sysdep-defalias 'other-frame 'other-screen)
  209. (sysdep-defalias 'previous-frame 'previous-screen)
  210. (sysdep-defalias 'previous-multiframe-window 'previous-multiscreen-window)
  211. (sysdep-defalias 'raise-frame
  212.   (cond ((fboundp 'raise-screen) 'raise-screen)
  213.     ((fboundp 'mapraise-screen) 'mapraise-screen)))
  214. (sysdep-defalias 'redraw-frame 'redraw-screen)
  215. (sysdep-defalias 'select-frame 'select-screen)
  216. (sysdep-defalias 'selected-frame 'selected-screen)
  217. (sysdep-defalias 'set-buffer-dedicated-frame 'set-buffer-dedicated-screen)
  218. (sysdep-defalias 'set-frame-height 'set-screen-height)
  219. (sysdep-defalias 'set-frame-left-margin-width 'set-screen-left-margin-width)
  220. (sysdep-defalias 'set-frame-position 'set-screen-position)
  221. (sysdep-defalias 'set-frame-right-margin-width 'set-screen-right-margin-width)
  222. (sysdep-defalias 'set-frame-size 'set-screen-size)
  223. (sysdep-defalias 'set-frame-width 'set-screen-width)
  224. (sysdep-defalias 'show-temp-buffer-in-current-frame 'show-temp-buffer-in-current-screen)
  225. (sysdep-defalias 'switch-to-buffer-other-frame 'switch-to-buffer-other-screen)
  226. (sysdep-defalias 'visible-frame-list 'visible-screen-list)
  227. (sysdep-defalias 'window-frame 'window-screen)
  228. (sysdep-defalias 'x-create-frame 'x-create-screen)
  229. (sysdep-defalias 'x-set-frame-icon-pixmap 'x-set-screen-icon-pixmap)
  230. (sysdep-defalias 'x-set-frame-pointer 'x-set-screen-pointer)
  231. (sysdep-defalias 'x-display-color-p 'x-color-display-p)
  232. (sysdep-defalias 'x-display-grayscale-p 'x-grayscale-display-p)
  233. (sysdep-defalias 'menu-event-p 'misc-user-event-p)
  234.  
  235. (sysdep-defun add-submenu (menu-path submenu &optional before)
  236.   "Add a menu to the menubar or one of its submenus.
  237. If the named menu exists already, it is changed.
  238. MENU-PATH identifies the menu under which the new menu should be inserted.
  239.  It is a list of strings; for example, (\"File\") names the top-level \"File\"
  240.  menu.  (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
  241.  If MENU-PATH is nil, then the menu will be added to the menubar itself.
  242. SUBMENU is the new menu to add.
  243.  See the documentation of `current-menubar' for the syntax.
  244. BEFORE, if provided, is the name of a menu before which this menu should
  245.  be added, if this menu is not on its parent already.  If the menu is already
  246.  present, it will not be moved."
  247.   (add-menu menu-path (car submenu) (cdr submenu) before))
  248.  
  249. (sysdep-defun add-menu-button (menu-path menu-leaf &optional before)
  250.   "Add a menu item to some menu, creating the menu first if necessary.
  251. If the named item exists already, it is changed.
  252. MENU-PATH identifies the menu under which the new menu item should be inserted.
  253.  It is a list of strings; for example, (\"File\") names the top-level \"File\"
  254.  menu.  (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
  255. MENU-LEAF is a menubar leaf node.  See the documentation of `current-menubar'.
  256. BEFORE, if provided, is the name of a menu item before which this item should
  257.  be added, if this item is not on the menu already.  If the item is already
  258.  present, it will not be moved."
  259.  (add-menu-item menu-path (aref menu-leaf 0) (aref menu-leaf 1)
  260.         (aref menu-leaf 2) before))
  261.  
  262. (sysdep-defun make-glyph (&optional spec-list)
  263.   (if (and spec-list (cdr-safe (assq 'x spec-list)))
  264.       (make-pixmap (cdr-safe (assq 'x spec-list)))))
  265.  
  266. ;; window functions
  267.  
  268. ;; not defined in v18
  269. (sysdep-defun window-minibuffer-p (window)
  270.   "Returns non-nil if WINDOW is a minibuffer window."
  271.   (eq window (minibuffer-window)))
  272.  
  273. ;; not defined in v18
  274. (sysdep-defun window-live-p (window)
  275.   "Returns t if OBJ is a window which is currently visible."
  276.   (and (windowp window)
  277.        (window-point window)))
  278.  
  279. ;; this parenthesis closes the if statement at the top of the file.
  280.  
  281. )
  282.  
  283. ;; DO NOT put a provide statement here.  This file should never be
  284. ;; loaded with `require'.  Use `load-library' instead.
  285.  
  286. ;;; sysdep.el ends here
  287.  
  288. ;;;(sysdep.el) Local Variables:
  289. ;;;(sysdep.el) eval: (put 'sysdep-defun 'lisp-indent-function 'defun)
  290. ;;;(sysdep.el) eval: (put 'sysdep-defalias 'lisp-indent-function 'defun)
  291. ;;;(sysdep.el) eval: (put 'sysdep-defconst 'lisp-indent-function 'defun)
  292. ;;;(sysdep.el) eval: (put 'sysdep-defvar 'lisp-indent-function 'defun)
  293. ;;;(sysdep.el) End:
  294.