home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / cmacexp.el < prev    next >
Encoding:
Text File  |  1992-09-15  |  16.9 KB  |  455 lines

  1. ;;; cmacexp.el
  2. ;;; This is a plug-in replacement for the GNU emacs 18.xx cmacexp.el.
  3. ;;; $Id: cmacexp.el 1.2 1992/09/15 11:34:56 pot Exp $
  4.  
  5. ;;; Author: pot@cnuce.cnr.it (Francesco Potorti`)
  6.  
  7. ;; This program is free software; you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation; either version 1, or (at your option)
  10. ;; any later version.
  11. ;;
  12. ;; This program is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. ;; GNU General Public License for more details.
  16. ;;
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with the Emacs program; if not, write to the Free Software
  19. ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21. ;; LISPDIR ENTRY for the Elisp Archive ===============================
  22.  
  23. ;; LCD Archive Entry:
  24. ;; cmacexp2|Francesco Potorti`|pot@cnuce.cnr.it|
  25. ;; cmacexp.el with corrections and improvements|
  26. ;; 92-09-15|1.2|~/misc/cmacexp.el.Z|*X|
  27.  
  28. ;; USAGE =============================================================
  29.  
  30. ;; In C mode C-M-x is bound to c-macro-expand.  The result of the
  31. ;; expansion is put in a separate buffer.  The buffer is put in
  32. ;; view-mode if the Inge Frick's view.el is installed.  A user option
  33. ;; allows the window displaying the buffer to be optimally sized.
  34. ;;
  35. ;; When called with a C-u prefix, c-macro-expand replaces the selected
  36. ;; region with the expansion.  With two C-u's the user is offered to
  37. ;; change the flags to the preprocessor (while the results of the
  38. ;; expansion go to a separate buffer).  Preprocessor arguments default
  39. ;; to the last ones entered.  Both the preprocessor name and the
  40. ;; initial flag defaults can be set by the user.  Setting
  41. ;; c-macro-always-prompt to a non-nil value allows one to be always
  42. ;; prompted for the flags, regardless of the prefix used.
  43.  
  44. ;; A c-macro-expansion function is provided for non-interactive use.
  45. ;; A still experimental function c-macro-eval is provided.  It aims at
  46. ;; evaluating the contents of a region by using calc (by Dave
  47. ;; Gillespie).  Select a region and type C-x C-e (if you followed the
  48. ;; suggestions in the INSTALLATION section) or type M-x c-ma RET v
  49. ;; RET.  If you have calc installed, the computed value of the
  50. ;; expression will appear in the message area.  If you give an
  51. ;; interactive C-u prefix the computed value will be shown in signed,
  52. ;; unsigned, hex and boolean representations.  Two C-u's allow to
  53. ;; change the preprocessor flags via prompt.  c-macro-eval works well
  54. ;; for constant expressions, but see the BUG section.
  55.  
  56. ;; A patch to calc 2.02 has been written by Dave Gillespie.  It can
  57. ;; be downloaded via anonymous ftp at fly.cnuce.cnr.it:pub/calc.diff.
  58.  
  59. ;; INSTALLATION ======================================================
  60.  
  61. ;; Put this file on your load-path, byte compile it for increased
  62. ;; speed and put part or all of the following in your ~/.emacs file.
  63.  
  64. ;; To make a directory ~/emacs be in front of your load-path:
  65. ;;(setq load-path (cons (expand-file-name "~/emacs") load-path))
  66. ;;
  67. ;; Suggested keybindings (work only in c-mode):
  68. ;;(define-key c-mode-map "\C-\M-x" 'c-macro-expand)
  69. ;;(define-key c-mode-map "\C-x\C-e" 'c-macro-eval)
  70. ;;
  71. ;; If you want the *Macroexpansion* window to be not higher than
  72. ;; necessary: 
  73. ;;(setq c-macro-shrink-window-p t)
  74. ;;
  75. ;; If you use a preprocessor other than /lib/cpp (be careful to set a
  76. ;; -C option or equivalent in order to make the preprocessor not to
  77. ;; strip the comments):
  78. ;;(setq c-macro-preprocessor "gpp -C")
  79. ;;
  80. ;; If you often use a particular set of flags, and want them to be
  81. ;; the default:
  82. ;;(setq c-macro-default-cppflags "-I /usr/include/local -DDEBUG"
  83. ;;
  84. ;; If you always want the "Preprocessor arguments: " prompt,
  85. ;; regardless of the arguments provided:
  86. ;;(setq c-macro-always-prompt-p t)
  87. ;;
  88. ;; If you want to experiment with the C constant expressions
  89. ;; evaluation feature:
  90. ;;(autoload 'c-macro-eval "cmacexp"
  91. ;;  "C constant expressions evaluation.  Requires calc.  Experimental." t)
  92.  
  93. ;; BUG REPORTS =======================================================
  94.  
  95. ;; Please report bugs, suggestions, complaints and so on to
  96. ;; pot@cnuce.cnr.it (Francesco Potorti`).
  97.  
  98. ;; IMPROVEMENTS OVER emacs 18.xx cmacexp.el ==========================
  99.  
  100. ;; - A lot of user visible changes.  See above.
  101. ;; - #line directives are inserted, so __LINE__ and __FILE__ are
  102. ;;   correctly expanded.  Works even with START inside a string, a
  103. ;;   comment or a region #ifdef'd away by cpp. cpp is invoked with -C,
  104. ;;   making comments visible in the expansion.
  105. ;; - All work is done in core memory, no need for temporary files.
  106. ;; - The /lib/cpp process is run synchronously.  This fixes an
  107. ;;   infinite loop bug on Motorola Delta (cpp waiting forever for
  108. ;;   end-of-file, don't know why).  Fixes a similar intermittent
  109. ;;   problem on SunOS 4.1.
  110.  
  111. ;; ACKNOWLEDGEMENTS ==================================================
  112.  
  113. ;; A lot of thanks to Don Maszle who did a great work of testing, bug
  114. ;; reporting and suggestion of new features, to Inge Fricks for her
  115. ;; help with view.el and to Dave Gillespie for his suggestions on
  116. ;; calc's use.  This work has been partially inspired by Don Maszle
  117. ;; and Jonathan Segal's.
  118.  
  119. ;; By the way, I recommend you Inge Frick's view.el.  It works like
  120. ;; the standard view, but *it is not recursive* and has some more
  121. ;; commands.  Moreover it is a minor mode, so you preserve all your
  122. ;; major mode keybindings (well, not always :).  Mail me to obtain a
  123. ;; copy, or get it by anonymous ftp in fly.cnuce.cnr.it:pub/view.el.
  124.  
  125. ;; BUGS ==============================================================
  126.  
  127. ;; calc 2.02 does not handle the C operators "->", ".", "*" (as a
  128. ;; prefix), the composite assignement operators "+=" etc.  It cannot
  129. ;; handle the "," operator and will be confused by ";".  Almost all
  130. ;; these can be defined as no-ops using the Calc's Syntax Tables
  131. ;; feature.  The built-in calc functions will cause problems in
  132. ;; certain circumstances.  c-macro-eval behaves correctly only on
  133. ;; expressions not containing such operators.  Does not distinguish
  134. ;; among integer and real division.
  135.  
  136. ;; If the start point of the region is inside a macro definition the
  137. ;; macro expansion is often inaccurate.
  138.  
  139.  
  140. (defvar c-macro-shrink-window-p nil
  141.   "*Non-nil means shrink the *Macroexpansion* window to fit its contents.")
  142.  
  143. (defvar c-macro-always-prompt-p nil
  144.   "*Non-nil means always prompt for preprocessor arguments.")
  145.  
  146. (defvar c-macro-preprocessor "/lib/cpp -C" "\
  147. The preprocessor used by the cmacexp package.
  148.  
  149. If you change this, be sure to preserve the -C (don't strip comments)
  150. option, or to set an equivalent one.")
  151.  
  152. (defvar c-macro-default-cppflags ""
  153.   "Default cpp flags used by c-macro-expand.")
  154.  
  155. (defconst c-macro-buffer-name "*Macroexpansion*")
  156.  
  157. (defun c-macro-expand (start end &optional flag) "\
  158. Expand all C macros occurring in the region using c-macro-preprocessor.
  159. Normally display output in temp buffer.
  160. Prefix arg means replace the region with it.
  161. Prompt for a string of arguments to the preprocessor, (e.g.
  162. -DDEBUG -I ./include) when prefixed with two C-u's.
  163.  
  164. It is intended for interactive use only.
  165. For non interactive use, see the c-macro-expansion function."
  166.  
  167.   (interactive "r\nP")
  168.   (let* ((subst (and flag (not (equal flag '(16)))))
  169.      (inbuf (current-buffer))
  170.      (displaybuf (if subst
  171.              (get-buffer c-macro-buffer-name)
  172.                (get-buffer-create c-macro-buffer-name)))
  173.      (expansion ""))
  174.     ;; Build the command string.
  175.     (if (or c-macro-always-prompt-p (equal flag '(16)))
  176.     (setq c-macro-default-cppflags
  177.           (read-string "Preprocessor arguments: "
  178.                c-macro-default-cppflags)))
  179.     ;; Decide where to display output.
  180.     (if (and subst
  181.          buffer-read-only
  182.          (not (eq inbuf displaybuf)))
  183.     (progn
  184.       (message
  185.        "Buffer is read only: displaying expansion in alternate window")
  186.       (sit-for 2)
  187.       (setq subst nil)
  188.       (or displaybuf
  189.           (setq displaybuf (get-buffer-create c-macro-buffer-name)))))
  190.     ;; Expand the macro and output it.
  191.     (if (interactive-p) (message (c-macro-default-message)))
  192.     (setq expansion
  193.       (c-macro-expansion start end
  194.                  (concat c-macro-preprocessor " "
  195.                      c-macro-default-cppflags)))
  196.     (message (concat (c-macro-default-message) "done"))
  197.     (if subst
  198.     (let ((exchange (= (point) start)))
  199.       (delete-region start end)
  200.       (insert expansion)
  201.       (if exchange
  202.           (exchange-point-and-mark)))
  203.       (set-buffer displaybuf)
  204.       (setq buffer-read-only nil)
  205.       (buffer-flush-undo displaybuf)
  206.       (erase-buffer)
  207.       (insert expansion)
  208.       (set-buffer-modified-p nil)
  209.       (if (string= "" expansion)
  210.       (message "Null expansion")
  211.     (c-macro-display-buffer inbuf))
  212.       (setq buffer-read-only t)
  213.       (bury-buffer displaybuf))))
  214.  
  215.  
  216. ;; Display the current buffer in a window which is either just large
  217. ;; enough to contain the entire buffer, or half the size of the
  218. ;; screen, whichever is smaller.  Put the current buffer in view-mode
  219. ;; if the Inge Frick's view-mode is installed, with buffer to return
  220. ;; to set to RETBUF (if sensible). Do not select the new window.
  221. ;;
  222. ;; Several factors influence window resizing so that the window is
  223. ;; sized optimally if it is created anew, and so that it is messed
  224. ;; with minimally if it has been created by the user.  If the window
  225. ;; chosen for display exists already but contains something else, the
  226. ;; window is not re-sized.  If the window already contains the current
  227. ;; buffer, it is never shrunk, but possibly expanded.  Finally, if the
  228. ;; variable c-macro-shrink-window-p is nil the window size is *never*
  229. ;; changed.
  230. (defun c-macro-display-buffer (retbuf)
  231.  
  232.   (goto-char (point-min))
  233.   (c-mode)
  234.   (require 'view)            ;load view.el
  235.   (let ((oldwinheight (window-height))
  236.     (alreadythere            ;the window was already there
  237.      (get-buffer-window (current-buffer)))
  238.     (popped nil)            ;the window popped changing the layout 
  239.     (niceview            ;is this Inge Fricks's view.el?
  240.      (boundp 'view-kill-when-finished)))
  241.  
  242.     (or alreadythere
  243.     (progn
  244.       (display-buffer (current-buffer) t)
  245.       (setq popped (/= oldwinheight (window-height)))))
  246.     (if niceview
  247.     (view-mode 1))            ;set view mode
  248.     (if (and c-macro-shrink-window-p    ;user wants fancy shrinking :\)
  249.          (or alreadythere popped))
  250.     ;; Enlarge up to half screen, or shrink properly.
  251.     (let ((oldwin (selected-window))
  252.           (minheight 0)
  253.           (maxheight 0))
  254.       (save-excursion
  255.         (select-window (get-buffer-window (current-buffer)))
  256.         (setq minheight (if alreadythere
  257.                 (window-height)
  258.                   window-min-height))
  259.         (setq maxheight (/ (screen-height) 2))
  260.         (enlarge-window (- (min maxheight
  261.                     (max minheight
  262.                      (+ 2 (vertical-motion 1000000))))
  263.                    (window-height)))
  264.         (goto-char (point-min))
  265.         (select-window oldwin))))))
  266.  
  267.  
  268. (defun c-macro-expansion (start end cppcommand) "\
  269. Expands the region between START and END in the current buffer using
  270. the shell command CPPCOMMAND (e.g. \"/lib/cpp -C -DDEBUG\").  Be sure
  271. to use a -C (don't strip comments) or equivalent option.
  272. Returns the output as a string."
  273.  
  274. ;; Copy the current buffer's contents to a temporary hidden buffer.
  275. ;; Delete from END to end of buffer.  Insert a preprocessor #line
  276. ;; directive at START and after each #endif following START that are
  277. ;; not inside a comment or a string.  Put all the strings thus
  278. ;; inserted (without the "line" substring) in a list named linelist.
  279. ;; If START is inside a comment, prepend "*/" and append "/*" to the
  280. ;; #line directive.  If inside a string, prepend and append "\"".
  281. ;; Preprocess the buffer contents, then look for all the lines stored
  282. ;; in linelist starting from end of buffer.  The last line so found is
  283. ;; where START was, so return the substring from point to end of
  284. ;; buffer. 
  285.   (let ((inbuf (current-buffer))
  286.     (outbuf (get-buffer-create " *C Macro Expansion*"))
  287.     (filename (if (and buffer-file-name
  288.                (string-match (regexp-quote default-directory)
  289.                      buffer-file-name))
  290.               (substring buffer-file-name (match-end 0))
  291.             (buffer-name)))
  292.     (linenum 0)
  293.     (linelist ()))
  294.     (unwind-protect
  295.     (save-excursion
  296.       (save-restriction
  297.         (widen)
  298.         (set-buffer outbuf)
  299.         (setq buffer-read-only nil)
  300.         (erase-buffer)
  301.         (set-syntax-table c-mode-syntax-table)
  302.         (insert-buffer-substring inbuf 1 end))
  303.  
  304.       ;; We have copied inbuf to outbuf.  Point is at end of
  305.       ;; outbuf.  Insert a space at the end, so cpp can correctly
  306.       ;; parse a token ending at END. 
  307.  
  308.       (insert " ")
  309.  
  310.       ;; Now we insert the #line directives after all #endif or
  311.       ;; #else following START. 
  312.       ;(switch-to-buffer outbuf) (debug)    ;debugging instructions
  313.       (while (re-search-backward "\n#\\(endif\\|else\\)\\>" start 'move)
  314.         (if (equal (nthcdr 3 (parse-partial-sexp 1 (point)))
  315.                '(nil nil nil 0)) ;neither in string nor in
  316.                      ;comment nor after quote
  317.         (progn
  318.           (goto-char (match-end 0))
  319.           (setq linenum (count-lines 1 (point)))
  320.           (setq linelist
  321.             (cons (format "\n# %d \"%s\"\n" linenum filename)
  322.                   linelist))
  323.           (insert (car linelist))
  324.           (skip-chars-backward "^#")
  325.           (insert "line")
  326.           (goto-char (match-beginning 0)))))
  327.  
  328.       ;; We are at START.  Insert the first #line directive.  This
  329.       ;; must work even inside a string or comment, or after a
  330.       ;; quote.
  331.       (setq linenum (+ (count-lines 1 (point))
  332.                (if (bolp) 1 0)))
  333.       (setq linelist
  334.         (cons
  335.          (let* ((startstat (parse-partial-sexp 1 start))
  336.             (startinstring (nth 3 startstat))
  337.             (startincomment (nth 4 startstat))
  338.             (startafterquote (nth 5 startstat)))
  339.            (concat (if startafterquote " ")
  340.                (cond (startinstring "\"") (startincomment "*/"))
  341.                (format "\n# %d \"%s\"\n" linenum filename)
  342.                (cond (startinstring "\"") (startincomment "/*"))
  343.                (if startafterquote "\\")))
  344.          linelist))
  345.       (insert (car linelist))
  346.       (skip-chars-backward "^#")
  347.       (insert "line")
  348.  
  349.       ;; Call the preprocessor.
  350.       (call-process-region 1 (point-max) "sh" t t nil "-c"
  351.                    (concat cppcommand " 2>/dev/null"))
  352.  
  353.       ;; Look for the `# nn "file.c"' lines from the last to the first
  354.       ;; and delete them.
  355.       (setq linelist (reverse linelist))
  356.       (while (progn
  357.            (if (search-backward (car linelist) nil t)
  358.                (replace-match ""))
  359.            (setq linelist (cdr linelist))))
  360.       
  361.       ;; Compute the return value, keeping in account the space
  362.       ;; inserted at the end of the buffer.
  363.       (buffer-substring (point) (max (point) (- (point-max) 1))))
  364.  
  365.       ;; Cleanup.
  366.       (kill-buffer outbuf))))
  367.  
  368.  
  369. ;; Experimental.  With an argument, print signed, unsigned, hex and
  370. ;; boolean representations.
  371. (defun c-macro-eval (start end &optional flag) "\
  372. Expand region using cpp and evaluate it using calc.
  373. Interactively print value in minibuffer and push it on the kill ring.
  374. With a C-u argument shows the evaluation in a variety of formats.
  375. With two C-u's prompts the user for a string of flags to the preprocessor.
  376.  
  377. Non interactively returns value of region between START and END
  378. as a string.  Several formats are used if optional FLAG is non-nil."
  379.  
  380.   (interactive "r\nP")
  381.   (or (fboundp 'calc-eval)
  382.       (require 'calc))
  383.   (if (or c-macro-always-prompt-p (equal flag '(16)))
  384.       (setq c-macro-default-cppflags
  385.         (read-string "Preprocessor arguments: "
  386.              c-macro-default-cppflags)))
  387.  
  388.   ;; Expand the region.
  389.   (if (interactive-p) (message (c-macro-default-message)))
  390.   (let ((evaluation
  391.      (c-macro-expansion start end
  392.                 (concat c-macro-preprocessor " "
  393.                     c-macro-default-cppflags)))
  394.     (evalbuf (get-buffer-create " *Macro Evaluation*")))
  395.     (unwind-protect
  396.     (save-excursion
  397.       (set-buffer evalbuf)
  398.       (setq buffer-read-only nil)
  399.       (erase-buffer)
  400.       (insert evaluation)
  401.  
  402.       ;; Evaluate expression(s).
  403.       (if (interactive-p)
  404.           (message "Invoking calc..."))
  405.       (setq evaluation
  406.         (let ((calc-eval-error t))
  407.           (calc-eval (list (buffer-string) 'calc-language 'c))))
  408.       (erase-buffer)
  409.       (cond
  410.        (flag
  411.         (insert (calc-eval (list evaluation
  412.                      'calc-language 'c
  413.                      'calc-simplify-mode 'binary))
  414.             "(u)" " == "
  415.             (calc-eval (list evaluation
  416.                      'calc-language 'c
  417.                      'calc-word-size (- calc-word-size)
  418.                      'calc-simplify-mode 'binary))
  419.             "(d)" " == "
  420.             (calc-eval (list evaluation
  421.                      'calc-language 'c
  422.                      'calc-number-radix 16
  423.                      'calc-simplify-mode 'binary))
  424.             "(x)")
  425.         (save-excursion
  426.           (insert " == " (calc-eval (list evaluation
  427.                           'calc-language 'c
  428.                           'calc-number-radix 16
  429.                           'calc-simplify-mode 'binary))))
  430.         (while (re-search-forward "0x\\([^,]+\\)\\(, \\|\\'\\)" nil t)
  431.           (if (string= "0"
  432.                (buffer-substring (match-beginning 1)
  433.                          (match-end 1)))
  434.           (replace-match "FALSE\\2")
  435.         (replace-match "TRUE\\2"))))
  436.        (t
  437.         (insert evaluation)))
  438.  
  439.       ;; Output the evaluation.
  440.       (if (interactive-p)
  441.           (progn
  442.         (copy-region-as-kill 1 (point-max))
  443.         (message (buffer-string)))
  444.         (buffer-string)))
  445.       (kill-buffer evalbuf))))
  446.  
  447. (defun c-macro-default-message ()
  448.   (format "Invoking %s%s%s on region..."
  449.       c-macro-preprocessor
  450.       (if (string= "" c-macro-default-cppflags) "" " ")
  451.       c-macro-default-cppflags))
  452.  
  453. (provide 'cmacexp)
  454.  
  455.