cgit.sxemacs.org Git - packages/blob - xemacs-packages/eieio/eieio-comp.el

   1 ;;; eieio-comp.el -- eieio routines to help with byte compilation
   2
   3 ;;;
   4 ;; Copyright (C) 1995,1996, 1998, 1999, 2000, 2001, 2002, 2005 Eric M. Ludlam
   5 ;;
   6 ;; Author: <zappo@gnu.org>
   7 ;; RCS: $Id: eieio-comp.el,v 1.6 2010-03-28 12:44:26 sperber-guest Exp $
   8 ;; Keywords: oop, lisp, tools
   9 ;;
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14 ;;
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24 ;;
  25 ;; Please send bug reports, etc. to zappo@gnu.org
  26
  27 ;;; Commentary:
  28 ;;
  29 ;; Byte compiler functions for defmethod.  This will affect the new GNU
  30 ;; byte compiler for Emacs 19 and better.  This function will be called by
  31 ;; the byte compiler whenever a `defmethod' is encountered in a file.
  32 ;; It will output a function call to `eieio-defmethod' with the byte
  33 ;; compiled function as a parameter.
  34
  35 ;;; Code:
  36
  37 ;; Some compatibility stuff
  38 (eval-and-compile
  39   (if (not (fboundp 'byte-compile-compiled-obj-to-list))
  40       ;; XEmacs change; b-c-c-o-t-l has been removed in 21.5
  41       (defun byte-compile-compiled-obj-to-list (compiled-function)
  42         (nconc (list
  43                 (compiled-function-arglist compiled-function)
  44                 (compiled-function-instructions compiled-function)
  45                 (compiled-function-constants compiled-function)
  46                 (compiled-function-stack-depth compiled-function)
  47                 (compiled-function-doc-string compiled-function))
  48                (if (commandp compiled-function)
  49                    (list (nth 1 (compiled-function-interactive
  50                                  compiled-function)))))))
  51   (if (not (boundp 'byte-compile-outbuffer))
  52       (defvar byte-compile-outbuffer nil))
  53   )
  54
  55 ;; This teaches the byte compiler how to do this sort of thing.
  56 (put 'defmethod 'byte-hunk-handler 'byte-compile-file-form-defmethod)
  57
  58 (defun byte-compile-file-form-defmethod (form)
  59   "Mumble about the method we are compiling.
  60 This function is mostly ripped from `byte-compile-file-form-defun', but
  61 it's been modified to handle the special syntax of the defmethod
  62 command.  There should probably be one for defgeneric as well, but
  63 that is called but rarely.  Argument FORM is the body of the method."
  64   (setq form (cdr form))
  65   (let* ((meth (car form))
  66          (key (progn (setq form (cdr form))
  67                      (cond ((eq ':BEFORE (car form))
  68                             (setq form (cdr form))
  69                             ":BEFORE ")
  70                            ((eq ':AFTER (car form))
  71                             (setq form (cdr form))
  72                             ":AFTER ")
  73                            ((eq ':PRIMARY (car form))
  74                             (setq form (cdr form))
  75                             ":PRIMARY ")
  76                            ((eq ':STATIC (car form))
  77                             (setq form (cdr form))
  78                             ":STATIC ")
  79                            (t ""))))
  80          (params (car form))
  81          (lamparams (byte-compile-defmethod-param-convert params))
  82          (arg1 (car params))
  83          (class (if (listp arg1) (nth 1 arg1) nil))
  84          (my-outbuffer (if (eval-when-compile
  85                              (string-match "XEmacs" emacs-version))
  86                            byte-compile-outbuffer outbuffer))
  87          )
  88     (let ((name (format "%s::%s" (or class "#<generic>") meth)))
  89       (if byte-compile-verbose
  90           ;; #### filename used free
  91           (message "Compiling %s... (%s)" (or filename "") name))
  92       (setq byte-compile-current-form name) ; for warnings
  93       )
  94     ;; Flush any pending output
  95     (byte-compile-flush-pending)
  96     ;; Byte compile the body.  For the byte compiled forms, add the
  97     ;; rest arguments, which will get ignored by the engine which will