home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / browser2.zip / br-macro.el < prev    next >
Text File  |  1995-02-17  |  6KB  |  180 lines
  1. ;;; CLASS BROWSER FOR C++
  2. ;;; $Id: br-macro.el,v 3.1 1995/02/17 18:19:36 mmann Exp $
  3. ;;;
  4. ;;; **********************************************************************
  5. ;;; Copyright (C) 1993, 1994 Gerd Moellmann. All rights reserved.
  6. ;;; Altenbergstr. 6, D-40235 Duesseldorf, Germany
  7. ;;; 100025.3303@COMPUSERVE.COM
  8. ;;; Suggestions, comments and requests for improvements are welcome.
  9. ;;; **********************************************************************
  10. ;;;
  11. ;;; This version works with both Emacs version 18 and 19, and I want
  12. ;;; to keep it that way. It requires the CL-19 Common Lisp compatibility
  13. ;;; package for Emacs 18 and 19.
  14. ;;;
  15. ;;; This file contains macros used in the browse package.
  16. ;;; 
  17.  
  18. ;; This file may be made part of the Emacs distribution at the option
  19. ;; of the FSF.
  20.  
  21. ;; This code is distributed in the hope that it will be useful,
  22. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  23. ;; accepts responsibility to anyone for the consequences of using it
  24. ;; or for whether it serves any particular purpose or works at all,
  25. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  26. ;; License for full details.
  27.  
  28. ;; Everyone is granted permission to copy, modify and redistribute
  29. ;; this code, but only under the conditions described in the
  30. ;; GNU Emacs General Public License.   A copy of this license is
  31. ;; supposed to have been given to you along with GNU Emacs so you
  32. ;; can know your rights and responsibilities.  It should be in a
  33. ;; file named COPYING.  Among other things, the copyright notice
  34. ;; and this notice must be preserved on all copies.
  35.  
  36. (require 'cl-19 "cl")
  37. (require 'backquote)
  38.  
  39. ;;;
  40. ;;; Running under Emacs 19?
  41. ;;; 
  42.  
  43. (defmacro browse-emacs-19-p ()
  44.   (` (memq 'emacs-19 browse-options)))
  45.  
  46. ;;;
  47. ;;; Set face of a region (Emacs19 and WINDOW-SYSTEM, only).
  48. ;;; 
  49.  
  50. (defmacro browse-set-face (start end face)
  51.   (when (and (browse-emacs-19-p) window-system)
  52.     (` (when (and browse-hilit-on-redisplay (, face))
  53.      (overlay-put (make-overlay (, start) (, end)) 'face (, face))))))
  54.  
  55. ;;; 
  56. ;;; Assign a text property depending on the circumstances.
  57. ;;;
  58.  
  59. (defmacro browse-put-text-property (start end prop value)
  60.   (when (browse-emacs-19-p)
  61.     (` (put-text-property (, start) (, end) (, prop) (, value)))))
  62.  
  63. (defmacro browse-get-text-property (point property)
  64.   (when (browse-emacs-19-p)
  65.     (` (get-text-property (, point) (, property)))))
  66.  
  67. ;;;
  68. ;;; Execute BODY in a non read-only buffer
  69. ;;; 
  70.  
  71. (defmacro browse-output (&rest body)
  72.   (let ((read-only (gensym "--browse-output--"))
  73.     (modified (gensym "--browse-output--")))
  74.     (` (let (((, read-only) buffer-read-only)
  75.          ((, modified) (buffer-modified-p)))
  76.      (unwind-protect
  77.          (progn
  78.            (setf buffer-read-only nil)
  79.            (,@ body))
  80.        (setf buffer-read-only (, read-only))
  81.        (set-buffer-modified-p (, modified)))))))
  82.  
  83. (put 'browse-output 'lisp-indent-hook 0)
  84.  
  85. ;;;
  86. ;;; Like DOLIST performing BODY over all trees in a tree.
  87. ;;;
  88. ;;; ??? Beginning with Emacs 19.27 (EMX, OS/2) we sometimes get symbols
  89. ;;; ??? out of the obarray that were never put into it, like 
  90. ;;; ??? `change-major-mode-hook'. It seems that this release has a minor
  91. ;;; ??? bug. Whatsoever that is the reason why the property value is
  92. ;;; ??? tested for being NIL.
  93. ;;; 
  94.  
  95. (defmacro dotrees (spec &rest body)
  96.   "(dotrees (tree vector) . body). Perform BODY over all trees in a 
  97. tree structure."
  98.   (let ((var (gensym "--dotrees--"))
  99.         (spec-var (car spec))
  100.         (array (cadr spec)))
  101.     (` (loop for (, var) being the symbols of (, array)
  102.          as (, spec-var) = (get (, var) 'browse-root) do
  103.          (when (vectorp (, spec-var))
  104.            (,@ body))))))
  105.  
  106. (put 'dotrees 'lisp-indent-hook 1)
  107.  
  108. ;;;
  109. ;;; Get screen or frame width depending on emacs version
  110. ;;; 
  111.  
  112. (defmacro browse-frame-width ()
  113.   (` (if (browse-emacs-19-p)
  114.          (frame-width)
  115.        (screen-width))))
  116.  
  117. ;;;
  118. ;;; Move to column COLUMN by inserting spaces and tabs.
  119. ;;; 
  120.  
  121. (defmacro browse-move-to-column (column)
  122.   (` (indent-to (, column))))
  123.  
  124. ;;;
  125. ;;; Replace all occurrences of OLD-LETTER by
  126. ;;; NEW-LETTER in string STR.  OLD-LETTER and NEW-LETTER have
  127. ;;; to be strings.
  128. ;;; 
  129.  
  130. (defmacro browse-replace-letter (str old new)
  131.   (` (mapconcat (function
  132.                  (lambda (c)
  133.                    (let ((s (char-to-string c)))
  134.                      (if (string= s (, old)) (, new) s))))
  135.                 (, str) "")))
  136.  
  137. ;;;
  138. ;;; Return the line the point is in.
  139. ;;; 
  140.  
  141. (defmacro browse-current-line ()
  142.   (` (+ (count-lines (point-min) (point))
  143.         (if (zerop (current-column)) 1 0)
  144.         -1)))
  145.  
  146. ;;;
  147. ;;; Perform BODY with COMPLETION-IGNORE-CASE set to T. Currently, this
  148. ;;; macro relies on Emacs Lisp's dynamic scoping. It will be changed
  149. ;;; when (let's hope) it changes to lexical scoping.
  150. ;;; 
  151.  
  152. (defmacro browse-completion-ignoring-case (&rest body)
  153.   (` (let ((completion-ignore-case t))
  154.        (,@ body))))
  155.  
  156. (put 'browse-completion-ignoring-case 'lisp-indent-hook 0)
  157.  
  158. ;;;
  159. ;;; Perform BODY with SELECTIVE-DISPLAY restored to old
  160. ;;; value after BODY is done.
  161. ;;; 
  162.  
  163. (defmacro browse-save-selective (&rest body)
  164.   (let ((var (gensym "--browse-save--")))
  165.     (` (let (((, var) selective-display))
  166.      (unwind-protect (progn (,@ body))
  167.        (setq selective-display (, var)))))))
  168.  
  169. (put 'browse-save-selective 'lisp-indent-hook 0)
  170.  
  171. ;;;
  172. ;;; Return T if the given TREE is the one for global functions, variables
  173. ;;; etc.
  174. ;;; 
  175.  
  176. (defmacro browse-global-tree-p (tree)
  177.   (` (string= (class-name (tree-class (, tree))) browse-global-tree-name)))
  178.  
  179. (provide 'br-macro)
  180.