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 / hm--html-menus / adapt.el next >
Encoding:
Text File  |  1995-08-26  |  5.9 KB  |  189 lines
  1. ;;; $Id: adapt.el,v 3.11 1995/08/22 20:38:55 muenkel Exp $
  2. ;;;
  3. ;;; Copyright (C) 1993, 1994, 1995  Heiko Muenkel
  4. ;;; email: muenkel@tnt.uni-hannover.de
  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, or (at your option)
  9. ;;;  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
  17. ;;;  along with this program; if not, write to the Free Software
  18. ;;;  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19. ;;;
  20. ;;; 
  21. ;;; Description:
  22. ;;;
  23. ;;;    General functions to port Lucid Emacs to GNU Emacs 19.
  24. ;;; 
  25. ;;; Installation: 
  26. ;;;   
  27. ;;;    Put this file in one of your lisp load directories.
  28. ;;;
  29.  
  30.  
  31. (defun adapt-xemacsp ()
  32.   "Returns non nil if the editor is the XEmacs."
  33.   (or (string-match "Lucid" emacs-version)
  34.       (string-match "XEmacs" emacs-version)))
  35.  
  36.  
  37. (defun adapt-lemacsp ()
  38.   "Returns non nil if the editor is the XEmacs.
  39. Old version, use `adapt-xemacsp' instead of this."
  40.   (or (string-match "Lucid" emacs-version)
  41.       (string-match "XEmacs" emacs-version)))
  42.  
  43.  
  44. (defun adapt-emacs19p ()
  45.   "Returns non nil if the editor is the GNU Emacs 19."
  46.   (and 
  47.    (not (adapt-xemacsp))
  48.    (string= (substring emacs-version 0 2) "19")))
  49.  
  50. ;;; Functions, which doesn't exist in both emacses
  51.  
  52. (defun adapt-region-active-p ()
  53.   "Returns t, if a region is active."
  54.   (if (adapt-xemacsp)
  55.       (mark)
  56.     mark-active))
  57.  
  58.  
  59. (if (adapt-emacs19p)
  60.     (progn
  61.       (load-library "lucid")
  62.  
  63.       (load-library "lmenu")
  64.  
  65.       (if window-system
  66.       (require 'font-lock)
  67.     )
  68.  
  69.       (make-face 'font-lock-comment-face)
  70.  
  71.       (defun read-number (prompt &optional integers-only)
  72.     "Reads a number from the minibuffer."
  73.     (interactive)
  74.     (let ((error t)
  75.           (number nil))
  76.       (if integers-only
  77.           (while error
  78.         (let ((input-string (read-string prompt)))
  79.           (setq number (if (string= "" input-string)
  80.                    nil
  81.                  (read input-string)))
  82.           (if (integerp number)
  83.               (setq error nil))))
  84.         (while error
  85.           (let ((input-string (read-string prompt)))
  86.         (setq number (if (string= "" input-string)
  87.                  nil
  88.                    (read input-string)))        
  89.         (if (numberp number)
  90.             (setq error nil)))))
  91.       number))
  92.  
  93.       (defvar original-read-string-function nil
  94.     "Points to the original Emacs 19 function read-string.")
  95.  
  96.       (if (not original-read-string-function)
  97.       (fset 'original-read-string-function
  98.         (symbol-function 'read-string)))
  99.  
  100.       (defun read-string (prompt &optional initial-contents history)
  101.     "Return a string from the minibuffer, prompting with string PROMPT.
  102. If non-nil, optional second arg INITIAL-CONTENTS is a string to insert
  103. in the minibuffer before reading.
  104. Third arg HISTORY, if non-nil, specifies a history list."
  105.     (read-from-minibuffer prompt initial-contents nil nil history))
  106.  
  107.       (defun make-extent (beg end &optional buffer)
  108.     (make-overlay beg end buffer))
  109.  
  110.       (defun set-extent-property (extent prop value)
  111.     (if (eq prop 'duplicable)
  112.         (cond ((and value (not (overlay-get extent prop)))
  113.            ;; If becoming duplicable, 
  114.            ;; copy all overlay props to text props.
  115.            (add-text-properties (overlay-start extent)
  116.                     (overlay-end extent)
  117.                     (overlay-properties extent)
  118.                     (overlay-buffer extent)))
  119.           ;; If becoming no longer duplicable, remove these text props.
  120.           ((and (not value) (overlay-get extent prop))
  121.            (remove-text-properties (overlay-start extent)
  122.                        (overlay-end extent)
  123.                        (overlay-properties extent)
  124.                        (overlay-buffer extent))))
  125.       ;; If extent is already duplicable, put this property
  126.       ;; on the text as well as on the overlay.
  127.       (if (overlay-get extent 'duplicable)
  128.           (put-text-property  (overlay-start extent)
  129.                   (overlay-end extent)
  130.                   prop value (overlay-buffer extent))))
  131.     (overlay-put extent prop value))
  132.       
  133.       (defun set-extent-face (extent face)
  134.     (set-extent-property extent 'face face))
  135.       
  136.       (defun delete-extent (extent)
  137.     (set-extent-property extent 'duplicable nil)
  138.     (delete-overlay extent))
  139.       
  140. ;      (defun make-extent (from to &optional buffer)
  141. ;    "Make extent for range [FROM, TO) in BUFFER -- BUFFER defaults to 
  142. ;current buffer.  Insertions at point TO will be outside of the extent;
  143. ;insertions at FROM will be inside the extent (and the extent will grow.).
  144. ;This is only a simple emulation of the Lucid Emacs extents !"
  145. ;    (list 'extent from to buffer))
  146. ;
  147. ;      (defun set-extent-face (extent face)
  148. ;    "Make the given EXTENT have the graphic attributes specified by FACE.
  149. ;This is only a simple emulation of the Lucid Emacs extents !"
  150. ;    (put-text-property (car (cdr extent))
  151. ;               (car (cdr (cdr extent)))
  152. ;               'face
  153. ;               face
  154. ;               (car (cdr (cdr (cdr extent))))))
  155. ;
  156. ;      (defun delete-extent (extent_obj)
  157. ;    "Remove EXTENT from its buffer; this does not modify the buffer's text,
  158. ;only its display properties.
  159. ;This is only a simple emulation of the Lucid Emacs extents !"
  160. ;    (remove-text-properties (car (cdr extent_obj))
  161. ;                (car (cdr (cdr extent_obj)))
  162. ;                (list 'face nil)
  163. ;                (car (cdr (cdr (cdr extent_obj))))))
  164. ;      
  165.  
  166.       (if (not (fboundp 'emacs-pid))
  167.       (defun emacs-pid ()
  168.         "Return the process ID of Emacs, as an integer.
  169. This is a dummy function for old versions of the Emacs 19.
  170. You should install a new version, which has `emacs-pid' implemented."
  171.         0)
  172.     )
  173.  
  174.       (if (not (fboundp 'facep))
  175.       (defun facep (object)
  176.         "Whether OBJECT is a FACE.
  177. It's only a dummy function in the Emacs 19, which returns always nil."
  178.         nil))
  179.       
  180. ;      (if (not (fboundp 'set-extent-property))
  181. ;      (defun set-extent-property (extent  property value)
  182. ;        "Change a property of an extent.
  183. ;Only a dummy version in Emacs 19."))
  184.  
  185.       ))
  186.     
  187.  
  188. (provide 'adapt)
  189.