emacs_el/tiny-tools/tiny/tinylibxe.el

   1 ;;; tinylibxe.el --- Compatibility library for both Emacs and XEmacs
   2
   3 ;; This file is not part of Emacs
   4
   5 ;;{{{ Id
   6
   7 ;; Copyright (C)    1997-2007 Jari Aalto
   8 ;; Keywords:        extensions
   9 ;; Author:          Jari Aalto
  10 ;; Maintainer:      Jari Aalto
  11 ;;
  12 ;; To get information on this program, call M-x tilibxe-version.
  13 ;; Look at the code with folding.el
  14
  15 ;; COPYRIGHT NOTICE
  16 ;;
  17 ;; This program is free software; you can redistribute it and/or modify it
  18 ;; under the terms of the GNU General Public License as published by the Free
  19 ;; Software Foundation; either version 2 of the License, or (at your option)
  20 ;; any later version.
  21 ;;
  22 ;; This program is distributed in the hope that it will be useful, but
  23 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  24 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  25 ;; for more details.
  26 ;;
  27 ;; You should have received a copy of the GNU General Public License
  28 ;; along with program; see the file COPYING. If not, write to the
  29 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  30 ;; Boston, MA 02110-1301, USA.
  31 ;;
  32 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
  33
  34 ;;}}}
  35 ;;{{{ Install
  36
  37 ;; ........................................................ &t-install ...
  38 ;; Put this file on your Emacs-Lisp load path, add following into your
  39 ;; package that you're currently developing. This ensures compatibility
  40 ;; for some extent to XEmacs and Emacs.
  41 ;;
  42 ;;      (require 'tinylibxe)
  43
  44 ;;}}}
  45 ;;{{{ Documentation
  46
  47 ;; ..................................................... &t-commentary ...
  48
  49 ;;; Commentary:
  50
  51 ;;  Preface 1996
  52 ;;
  53 ;;      o   This is library, package itself does nothing.
  54 ;;      o   Compatibility for both Emacsen, XEmacs and Emacs
  55 ;;      o   Compatibility for older Emacsen. Code written using later Emacs
  56 ;;          versions can be run under lower Emacs version. (e.g.
  57 ;;          `require' includes extra parameters in later Emacs versions.
  58 ;;
  59 ;;      There are incompatibilities between XEmacs and Emacs which
  60 ;;      prevent writing portable code. The bigger problematic things
  61 ;;      have been collected here. The trivial ones have been implemented
  62 ;;      in lower level libraries like in backward compatibility
  63 ;;      library *tinylibb.el*.
  64 ;;
  65 ;;  Overlay.el in XEmacs 19.15+
  66 ;;
  67 ;;      Good news; Latest XEmacs includes package that emulates
  68 ;;      Emacs overlay functions. Load it under XEmacs, if you run code
  69 ;;      written using Emacs.
  70 ;;
  71 ;;  What you should know -- keep this in mind
  72 ;;
  73 ;;      This library's intention is to make it possible to use some package
  74 ;;      that is written only for Emacs. Normally it is not possible to use
  75 ;;      package under another Emacs, because there may be function calls
  76 ;;      that depend on Emacs flavor.
  77 ;;
  78 ;;      When this file is loaded, it emulates unknown functions as much as
  79 ;;      it can. However, it may not be possible to reproduce exactly the
  80 ;;      same behavior that was not the primary target for the package. The
  81 ;;      emulation may at worst case be only so, that you are able to load
  82 ;;      the package without errors, but the functionality of the package
  83 ;;      doesn't correspond to the original's.
  84
  85 ;;}}}
  86
  87 ;;; Change Log:
  88
  89 ;;; Code:
  90
  91 ;;{{{ setup: require
  92
  93 (require 'tinylibm)
  94
  95 ;;}}}
  96 ;;{{{ setup: -- version
  97
  98 (defconst tinylibxe-version
  99   "$Revision: 2.49 $"
 100   "Latest version number.")
 101
 102 (defconst tinylibxe-version-id
 103   "$Id: tinylibxe.el,v 2.49 2007/05/07 10:50:08 jaalto Exp $"
 104   "Latest modification time and version number.")
 105
 106 (defun tinylibxe-version (&optional arg)
 107   "version information."
 108   (interactive "P")
 109   (ti::package-version-info "tinylibxe.el" arg))
 110
 111 (defun tinylibxe-submit-bug-report ()
 112   "Submit bug report."
 113   (interactive)
 114   (ti::package-submit-bug-report
 115    "tinylibxe.el"
 116    tinylibxe-version-id
 117    '(tinylibxe-version-id)))
 118
 119 ;;}}}
 120 ;;{{{ events, window, frames, misc
 121
 122 (cond
 123  ((ti::emacs-p)
 124   (defalias 'event-window       'posn-window)
 125   (defalias 'event-point        'posn-point)
 126   (defalias 'event-timestamp    'posn-timestamp)
 127   (defalias 'window-pixel-edges 'window-edges))
 128  (t
 129   (defalias 'posn-window        'event-window)
 130   (defalias 'posn-window        'event-window)
 131   (defalias 'posn-point         'event-point)
 132   (defalias 'posn-timestamp     'event-timestamp)
 133 ;;;  (defalias 'posn-col-row    ')
 134   (defalias 'window-edges       'window-pixel-edges)))
 135
 136 ;;; From wid-edit.el
 137 ;;;
 138 (ti::fboundp-check-autoload 'button-release-event-p "tinylibxe"
 139                             ;; XEmacs function missing from Emacs.
 140                             (defun button-release-event-p (event)
 141                               "Non-nil if EVENT is a mouse-button-release event object."
 142                               (and (eventp event)
 143                                    (memq (ti::funcall 'event-basic-type event)
 144                                          '(mouse-1 mouse-2 mouse-3))
 145                                    (or (memq 'click (event-modifiers event))
 146                                        (memq  'drag (event-modifiers event))))))
 147
 148 (ti::fboundp-check-autoload  'event-start "tinylibxe"
 149                              (defun event-start (event)
 150                                "tinylibxe.el"
 151                                ;; In Emacs (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
 152                                (list
 153                                 (ti::funcall 'event-window event)
 154                                 (ti::funcall 'event-point event)
 155                                 (ti::funcall 'posn-x-y event)
 156                                 (ti::funcall 'event-timestamp event))))
 157
 158 (ti::fboundp-check-autoload  'event-x "tinylibxe"
 159                              (defun event-x (event)
 160                                "tinylibxe.el"
 161                                (let* ((data (ti::funcall 'event-start event)))
 162                                  (car data))))
 163
 164 (ti::fboundp-check-autoload  'event-y "tinylibxe"
 165                              (defun event-y (event)
 166                                "tinylibxe.el"
 167                                (let* ((data (ti::funcall 'event-start event)))
 168                                  (cdr data))))
 169
 170 (ti::fboundp-check-autoload  'posn-x-y "tinylibxe"
 171                              (defun posn-x-y (event)
 172                                "tinylibxe.el"
 173                                (cons (ti::funcall 'event-x event) (ti::funcall 'event-y event))))
 174
 175 (when (and (not (fboundp 'frame-parameters)) ;obsolete in 19.14
 176            (boundp 'frame-properties))
 177   (defun frame-parameters (&optional frame)
 178     "Return FRAME parameters."
 179     ;;  Emacs   ((arg1 . val) (arg2 . val) ..)
 180     ;;  XEmacs  (arg val arg2 val)
 181     (ti::list-to-cons (ti::funcall 'frame-properties))))
 182
 183 ;;}}}
 184 ;;{{{ faces
 185
 186 ;;; XEmacs /Emacs don't have compatible faces
 187
 188 (and (not (fboundp 'x-display-color-p))
 189      (fboundp 'device-class)
 190      (defalias 'x-display-color-p 'device-class))
 191
 192 (unless (ti::compat-face-p 'region)
 193   (make-face 'region)
 194   (set-face-foreground 'region "white")
 195   (set-face-background 'region "black"))
 196
 197 (ti::fboundp-check-autoload 'set-background-color "tinylibxe"
 198                             (defun set-background-color (colour)
 199                               "Tinylibxe. Emacs emulation"
 200                               (ti::funcall 'set-face-background 'default colour)))
 201
 202 (ti::fboundp-check-autoload 'set-foreground-color "tinylibxe"
 203                             (defun set-foreground-color (colour)
 204                               "Tinylibxe. Emacs emulation"
 205                               (ti::funcall 'set-face-foreground 'default colour)))
 206
 207 (ti::fboundp-check-autoload 'set-cursor-color "tinylibxe"
 208                             (defun set-cursor-color (colour)
 209                               "Tinylibxe. Emacs emulation"
 210                               (ti::funcall 'set-face-foreground 'text-cursor colour)))
 211
 212 (ti::fboundp-check-autoload 'transient-mark-mode "tinylibxe"
 213                             (defun transient-mark-mode (&optional mode)
 214                               "Tinylibxe. Emacs emulation"
 215                               (interactive)
 216                               (set 'zmacs-regions (ti::bool-toggle mode))))
 217
 218 ;;}}}
 219 ;;{{{ dired
 220
 221 (cond
 222  ((ti::emacs-p)
 223   (defalias  'dired-unmark-subdir-or-file   'dired-unmark)
 224   (defalias  'dired-mark-subdir-or-file     'dired-mark)
 225   (defalias  'dired-mark-get-files          'dired-get-marked-files)
 226   (defalias  'dired-mark-map                'dired-map-over-marks))
 227  (t
 228   (defalias 'dired-unmark           'dired-unmark-subdir-or-file)
 229   (defalias 'dired-mark             'dired-mark-subdir-or-file)
 230   (defalias 'dired-get-marked-files 'dired-mark-get-files)
 231   (defalias 'dired-map-over-marks   'dired-mark-map)))
 232
 233 ;;}}}
 234 ;;{{{ glyphs
 235
 236 ;;; Thanks to Kyle Jone,  kyle@wonderworks.com, in setnu.el
 237
 238 (when (and nil (ti::emacs-p)) ;; disabled now
 239   (defalias 'extent-live-p              'overlayp)
 240   (defalias 'extentp                    'overlayp)
 241   (defalias 'make-extent                'make-overlay)
 242   (defalias 'delete-extent              'delete-overlay)
 243   (defalias 'extent-property            'overlay-get)
 244   (defalias 'set-extent-property        'overlay-put)
 245   (defalias 'set-extent-endpoints       'move-overlay)
 246   (defalias 'extent-end-position        'overlay-end)
 247   (defalias 'extent-start-position      'overlay-start)
 248   (defalias 'extent-start-position      'overlay-buffer)
 249   (defalias 'extent-start-position      'overlay-buffer)
 250   (defalias 'next-extent-change         'next-overlay-change)
 251   (defalias 'extent-properties          'overlay-properties)
 252
 253   (defun extent-list (buffer point)
 254     "tinylibxe.el -- arg3 not supported."
 255     (save-excursion
 256       (if buffer
 257           (set-buffer buffer))
 258       (ti::funcall 'overlays-at point)))
 259
 260   (defun extent-length (e)
 261     "tinylibxe.el -- return overlay length."
 262     (- (ti::funcall 'overlay-end e) (ti::funcall 'overlay-start e))))
 263
 264 (defvar ti:xe-begin-glyph-property (if (fboundp 'extent-property)
 265                                        'begin-glyph
 266                                      'before-string)
 267   "Property name to use to set teh begin glyph of an extent.")
 268
 269 (ti::fboundp-check-autoload  'set-overlay-begin-glyph "tinylibxe"
 270                              (defun set-overlay-begin-glyph (e g)
 271                                "tinylibxe -- Set glyph G in overlay E."
 272                                (ti::funcall 'overlay-put e ti:xe-begin-glyph-property g)))
 273
 274 (ti::fboundp-check-autoload  'make-glyph "tinylibxe"
 275                              (defalias 'make-glyph 'identity))
 276
 277 (cond
 278  ((ti::emacs-p)
 279   (unless (fboundp  'set-glyph-face)
 280     (defun set-glyph-face (g face)
 281       "tinylibxe -- Set glyph G to FACE"
 282       (put-text-property 0 (length g) 'face face g))))
 283
 284  (t
 285   ;;(defalias 'set-glyph-face 'ignore)
 286   nil))
 287
 288 ;;}}}
 289 ;;{{{ misc
 290
 291 (when (and nil                          ;Idea only...
 292            (not (fboundp 'easy-menu-add-item))
 293            (fboundp 'add-menu-button))
 294   (defun easy-menu-add-item ()
 295     (cond
 296      ((fboundp 'easy-menu-add-item)     ;XEmacs 21.x
 297       (easy-menu-add-item 'rest-of-the-args))
 298      ((fboundp 'add-menu-button)        ;XEmacs
 299       ;; (add-menu-button
 300       ;; '("Tools")
 301       ;; ["List Ediff Sessions" ediff-show-registry t] "OO-Browser...")
 302       nil)
 303      (t
 304       (define-key
 305         ;; support for pre FSF 20.3
 306         'nothing-yet
 307         'nothing-yet)))))
 308
 309 ;;; From wid-edit.el by Per Abrahamsen <abraham@dina.kvl.dk>
 310 (when (and (not (fboundp 'error-message-string))
 311            (fboundp 'display-error))
 312   ;; Emacs function missing in XEmacs.
 313   (defun error-message-string (obj)
 314     "Convert an error value to an error message."
 315     (let ((buffer (get-buffer-create " *error-message*")))
 316       (with-current-buffer buffer
 317         (erase-buffer)
 318         ;;  Only exist in new emacs release
 319         (ti::funcall 'display-error obj buffer)
 320         (buffer-string)))))
 321
 322 ;; XEmacs  doesn't have 'timer package; but 'itimer
 323 (ti::fboundp-check-autoload 'run-at-time "tinylibxe"
 324                             (defun run-at-time  (time repeat function &rest args)
 325                               "tinylibxe -- XEmacs and Emacs Compatibility."
 326                               (require 'itimer)
 327                               ;;  start-itimer: (name function value &optional restart)
 328                               ;;  start-itimer: (NAME FUNCTION VALUE &optional RESTART IS-IDLE WITH-ARGS
 329                               ;;                 &rest FUNCTION-ARGUMENTS)
 330                               ;;  We can't use following Emacs arguments: ARGS
 331                               ;;  (run-at-time TIME REPEAT FUNCTION &rest ARGS)
 332                               (ti::funcall
 333                                'start-itimer
 334                                (cond    ;ARG1 NAME
 335                                 ((symbolp function)
 336                                  (symbol-name function))
 337                                 (t
 338                                  "itimer-with-no-name"))
 339                                function              ;ARG2 FUNCTION
 340                                (if (integerp repeat) ;ARG3 VALUE
 341                                    repeat 10)
 342                                (if (integerp repeat) ;ARG4 &optional RESTART
 343                                    repeat 10))))
 344
 345 (ti::fboundp-check-autoload  'cancel-timer "tinylibxe"
 346                              (defun cancel-timer (timer)
 347                                "tinylibxe -- XEmacs & Emacs Compatibility."
 348                                (ti::funcall 'delete-itimer timer)))
 349
 350 ;;}}}
 351 ;;{{{ advice: code from XEmacs --> Emacs
 352
 353 (when (ti::xemacs-p)
 354   (require 'advice)
 355
 356   ;;  This is same as 'beep'
 357   ;;  Emacs, subr.el:(defalias 'beep 'ding) ;preserve lingual purity
 358   ;;
 359   (defadvice ding (around tinylibxe (&optional arg &rest args) act)
 360     "tinylibxe -- Define Xemacs compatible ding comamnd. Ignores arg 2."
 361     ad-do-it)
 362
 363   (defadvice make-sparse-keymap (before tinylibxe (&optional no-op) act)
 364     "tinylibxe -- This advice does nothing except adding an optional argument
 365 to keep the byte compiler happy when compiling Emacs specific code
 366 with XEmacs."))
 367
 368 ;;}}}
 369
 370 (provide   'tinylibxe)
 371
 372 ;;; tinylibxe.el ends here