code.delx.au - gnu-emacs/blob - lisp/progmodes/cc-defs.el

   1 ;;; cc-defs.el --- compile time definitions for CC Mode
   2
   3 ;; Copyright (C) 1985,1987,1992-2001 Free Software Foundation, Inc.
   4
   5 ;; Authors:    2000- Martin Stjernholm
   6 ;;             1998-1999 Barry A. Warsaw and Martin Stjernholm
   7 ;;             1992-1997 Barry A. Warsaw
   8 ;;             1987 Dave Detlefs and Stewart Clamen
   9 ;;             1985 Richard M. Stallman
  10 ;; Maintainer: bug-cc-mode@gnu.org
  11 ;; Created:    22-Apr-1997 (split from cc-mode.el)
  12 ;; Version:    See cc-mode.el
  13 ;; Keywords:   c languages oop
  14
  15 ;; This file is part of GNU Emacs.
  16
  17 ;; GNU Emacs is free software; you can redistribute it and/or modify
  18 ;; it under the terms of the GNU General Public License as published by
  19 ;; the Free Software Foundation; either version 2, or (at your option)
  20 ;; any later version.
  21
  22 ;; GNU Emacs is distributed in the hope that it will be useful,
  23 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  25 ;; GNU General Public License for more details.
  26
  27 ;; You should have received a copy of the GNU General Public License
  28 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  29 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  30 ;; Boston, MA 02111-1307, USA.
  31
  32 ;;; Commentary:
  33
  34 ;;; Code:
  35
  36 (eval-when-compile
  37   (let ((load-path
  38          (if (and (boundp 'byte-compile-dest-file)
  39                   (stringp byte-compile-dest-file))
  40              (cons (file-name-directory byte-compile-dest-file) load-path)
  41            load-path)))
  42     (require 'cc-bytecomp)))
  43
  44 ;; cc-mode-19.el contains compatibility macros that should be used if
  45 ;; needed.
  46 (eval-and-compile
  47   (if (or (not (fboundp 'functionp))
  48           (not (condition-case nil
  49                    (progn (eval '(char-before)) t)
  50                  (error nil)))
  51           (not (condition-case nil
  52                    (progn (eval '(char-after)) t)
  53                  (error nil)))
  54           (not (fboundp 'when))
  55           (not (fboundp 'unless)))
  56       (cc-load "cc-mode-19")))
  57
  58 ;; Silence the compiler.
  59 (cc-bytecomp-defvar c-enable-xemacs-performance-kludge-p) ; In cc-vars.el
  60 (cc-bytecomp-defvar c-buffer-is-cc-mode) ; In cc-vars.el
  61 (cc-bytecomp-defun buffer-syntactic-context-depth) ; XEmacs
  62 (cc-bytecomp-defun region-active-p)     ; XEmacs
  63 (cc-bytecomp-defvar zmacs-region-stays) ; XEmacs
  64 (cc-bytecomp-defvar zmacs-regions)      ; XEmacs
  65 (cc-bytecomp-defvar mark-active)        ; Emacs
  66 (cc-bytecomp-defun scan-lists)          ; 5 args in XEmacs, 3 in Emacs
  67 (require 'derived)                      ; Only necessary in Emacs
  68
  69 \f
  70 ;;; Macros.
  71
  72 ;;; Helpers for building regexps.
  73 (defmacro c-paren-re (re)
  74   `(concat "\\(" ,re "\\)"))
  75 (defmacro c-identifier-re (re)
  76   `(concat "\\<\\(" ,re "\\)\\>[^_]"))
  77
  78 (defmacro c-point (position &optional point)
  79   ;; Returns the value of certain commonly referenced POSITIONs
  80   ;; relative to POINT.  The current point is used if POINT isn't
  81   ;; specified.  POSITION can be one of the following symbols:
  82   ;;
  83   ;; bol  -- beginning of line
  84   ;; eol  -- end of line
  85   ;; bod  -- beginning of defun
  86   ;; eod  -- end of defun
  87   ;; boi  -- beginning of indentation
  88   ;; ionl -- indentation of next line
  89   ;; iopl -- indentation of previous line
  90   ;; bonl -- beginning of next line
  91   ;; eonl -- end of next line
  92   ;; bopl -- beginning of previous line
  93   ;; eopl -- end of previous line
  94   ;;
  95   ;; If the referenced position doesn't exist, the closest accessible
  96   ;; point to it is returned.  This function does not modify point or
  97   ;; mark.
  98   `(save-excursion
  99      ,(if point `(goto-char ,point))
 100      ,(if (and (eq (car-safe position) 'quote)
 101                (symbolp (eval position)))
 102           (let ((position (eval position)))
 103             (cond
 104              ((eq position 'bol)  `(beginning-of-line))
 105              ((eq position 'eol)  `(end-of-line))
 106              ((eq position 'boi)  `(back-to-indentation))
 107              ((eq position 'bod)  `(c-beginning-of-defun-1))
 108              ((eq position 'bonl) `(forward-line 1))
 109              ((eq position 'bopl) `(forward-line -1))
 110              ((eq position 'eod)  `(c-end-of-defun-1))
 111              ((eq position 'eopl) `(progn
 112                                      (beginning-of-line)
 113                                      (or (bobp) (backward-char))))
 114              ((eq position 'eonl) `(progn
 115                                      (forward-line 1)
 116                                      (end-of-line)))
 117              ((eq position 'iopl) `(progn
 118                                      (forward-line -1)
 119                                      (back-to-indentation)))
 120              ((eq position 'ionl) `(progn
 121                                      (forward-line 1)
 122                                      (back-to-indentation)))
 123              (t (error "unknown buffer position requested: %s" position))))
 124         ;;(message "c-point long expansion")
 125         `(let ((position ,position))
 126            (cond
 127             ((eq position 'bol)  (beginning-of-line))
 128             ((eq position 'eol)  (end-of-line))
 129             ((eq position 'boi)  (back-to-indentation))
 130             ((eq position 'bod)  (c-beginning-of-defun-1))
 131             ((eq position 'bonl) (forward-line 1))
 132             ((eq position 'bopl) (forward-line -1))
 133             ((eq position 'eod)  (c-end-of-defun-1))
 134             ((eq position 'eopl) (progn
 135                                    (beginning-of-line)
 136                                    (or (bobp) (backward-char))))
 137             ((eq position 'eonl) (progn
 138                                    (forward-line 1)
 139                                    (end-of-line)))
 140             ((eq position 'iopl) (progn
 141                                    (forward-line -1)
 142                                    (back-to-indentation)))
 143             ((eq position 'ionl) (progn
 144                                    (forward-line 1)
 145                                    (back-to-indentation)))
 146             (t (error "unknown buffer position requested: %s" position)))))
 147      (point)))
 148
 149 (defmacro c-safe (&rest body)
 150   ;; safely execute BODY, return nil if an error occurred
 151   `(condition-case nil
 152        (progn ,@body)
 153      (error nil)))
 154 (put 'c-safe 'lisp-indent-function 0)
 155
 156 (defmacro c-forward-sexp (&optional arg)
 157   ;; like forward-sexp except
 158   ;;   1. this is much stripped down from the XEmacs version
 159   ;;   2. this cannot be used as a command, so we're insulated from
 160   ;;      XEmacs' losing efforts to make forward-sexp more user
 161   ;;      friendly
 162   ;;   3. Preserves the semantics most of CC Mode is based on
 163   (or arg (setq arg 1))
 164   `(goto-char (or (scan-sexps (point) ,arg)
 165                   ,(if (numberp arg)
 166                        (if (> arg 0) `(point-max) `(point-min))
 167                      `(if (> ,arg 0) (point-max) (point-min))))))
 168
 169 (defmacro c-backward-sexp (&optional arg)
 170   ;; See c-forward-sexp and reverse directions
 171   (or arg (setq arg 1))
 172   `(c-forward-sexp ,(if (numberp arg) (- arg) `(- ,arg))))
 173
 174 ;; Wrappers for common scan-lists cases, mainly because it's almost
 175 ;; impossible to get a feel for how that function works.
 176 (defmacro c-up-list-forward (pos)
 177   `(c-safe (scan-lists ,pos 1 1)))
 178 (defmacro c-up-list-backward (pos)
 179   `(c-safe (scan-lists ,pos -1 1)))
 180 (defmacro c-down-list-forward (pos)
 181   `(c-safe (scan-lists ,pos 1 -1)))
 182 (defmacro c-down-list-backward (pos)
 183   `(c-safe (scan-lists ,pos -1 -1)))
 184
 185 (defmacro c-add-syntax (symbol &optional relpos)
 186   ;; a simple macro to append the syntax in symbol to the syntax list.
 187   ;; try to increase performance by using this macro
 188   `(let ((relpos-tmp ,relpos))
 189      (if relpos-tmp (setq syntactic-relpos relpos-tmp))
 190      (setq syntax (cons (cons ,symbol relpos-tmp) syntax))))
 191
 192 (defmacro c-benign-error (format &rest args)
 193   ;; Formats an error message for the echo area and dings, i.e. like
 194   ;; `error' but doesn't abort.
 195   `(progn
 196      (message ,format ,@args)
 197      (ding)))
 198
 199 (defmacro c-update-modeline ()
 200   ;; set the c-auto-hungry-string for the correct designation on the modeline
 201   `(progn
 202      (setq c-auto-hungry-string
 203            (if c-auto-newline
 204                (if c-hungry-delete-key "/ah" "/a")
 205              (if c-hungry-delete-key "/h" nil)))
 206      (force-mode-line-update)))
 207
 208 (defmacro c-with-syntax-table (table &rest code)
 209   ;; Temporarily switches to the specified syntax table in a failsafe
 210   ;; way to execute code.
 211   `(let ((c-with-syntax-table-orig-table (syntax-table)))
 212      (unwind-protect
 213          (progn
 214            (set-syntax-table ,table)
 215            ,@code)
 216        (set-syntax-table c-with-syntax-table-orig-table))))
 217 (put 'c-with-syntax-table 'lisp-indent-function 1)
 218
 219 (defmacro c-skip-ws-forward (&optional limit)
 220   "Skip over any whitespace following point.
 221 This function skips over horizontal and vertical whitespace and line
 222 continuations."
 223   (if limit
 224       `(let ((-limit- (or ,limit (point-max))))
 225          (while (progn
 226                   ;; skip-syntax-* doesn't count \n as whitespace..
 227                   (skip-chars-forward " \t\n\r\f" -limit-)
 228                   (when (and (eq (char-after) ?\\)
 229                              (< (point) -limit-))
 230                     (forward-char)
 231                     (or (eolp)
 232                         (progn (backward-char) nil))))))
 233     '(while (progn
 234               (skip-chars-forward " \t\n\r\f")
 235               (when (eq (char-after) ?\\)
 236                 (forward-char)
 237                 (or (eolp)
 238                     (progn (backward-char) nil)))))))
 239
 240 (defmacro c-skip-ws-backward (&optional limit)
 241   "Skip over any whitespace preceding point.
 242 This function skips over horizontal and vertical whitespace and line
 243 continuations."
 244   (if limit
 245       `(let ((-limit- (or ,limit (point-min))))
 246          (while (progn
 247                   ;; skip-syntax-* doesn't count \n as whitespace..
 248                   (skip-chars-backward " \t\n\r\f" -limit-)
 249                   (and (eolp)
 250                        (eq (char-before) ?\\)
 251                        (> (point) -limit-)))
 252            (backward-char)))
 253     '(while (progn
 254               (skip-chars-backward " \t\n\r\f")
 255               (and (eolp)
 256                    (eq (char-before) ?\\)))
 257        (backward-char))))
 258
 259 ;; Make edebug understand the macros.
 260 (eval-after-load "edebug"
 261   '(progn
 262      (def-edebug-spec c-paren-re t)
 263      (def-edebug-spec c-identifier-re t)
 264      (def-edebug-spec c-point ([&or symbolp form] &optional form))
 265      (def-edebug-spec c-safe t)
 266      (def-edebug-spec c-forward-sexp (&optional [&or numberp form]))
 267      (def-edebug-spec c-backward-sexp (&optional [&or numberp form]))
 268      (def-edebug-spec c-up-list-forward t)
 269      (def-edebug-spec c-up-list-backward t)
 270      (def-edebug-spec c-down-list-forward t)
 271      (def-edebug-spec c-down-list-backward t)
 272      (def-edebug-spec c-add-syntax t)
 273      (def-edebug-spec c-add-class-syntax t)
 274      (def-edebug-spec c-benign-error t)
 275      (def-edebug-spec c-with-syntax-table t)
 276      (def-edebug-spec c-skip-ws-forward t)
 277      (def-edebug-spec c-skip-ws-backward t)))
 278
 279 ;;; Inline functions.
 280
 281 ;; Note: All these after the macros, to be on safe side in avoiding
 282 ;; bugs where macros are defined too late.  These bugs often only show
 283 ;; when the files are compiled in a certain order within the same
 284 ;; session.
 285
 286 (defsubst c-beginning-of-defun-1 ()
 287   ;; Wrapper around beginning-of-defun.
 288   ;;
 289   ;; NOTE: This function should contain the only explicit use of
 290   ;; beginning-of-defun in CC Mode.  Eventually something better than
 291   ;; b-o-d will be available and this should be the only place the
 292   ;; code needs to change.  Everything else should use
 293   ;; (c-beginning-of-defun-1)
 294   (if (and (fboundp 'buffer-syntactic-context-depth)
 295            c-enable-xemacs-performance-kludge-p)
 296       ;; XEmacs only.  This can improve the performance of
 297       ;; c-parse-state to between 3 and 60 times faster when
 298       ;; braces are hung.  It can also degrade performance by
 299       ;; about as much when braces are not hung.
 300       (let (pos)
 301         (while (not pos)
 302           (save-restriction
 303             (widen)
 304             (setq pos (scan-lists (point) -1
 305                                   (buffer-syntactic-context-depth)
 306                                   nil t)))
 307           (cond
 308            ((bobp) (setq pos (point-min)))
 309            ((not pos)
 310             (let ((distance (skip-chars-backward "^{")))
 311               ;; unbalanced parenthesis, while illegal C code,
 312               ;; shouldn't cause an infloop!  See unbal.c
 313               (when (zerop distance)
 314                 ;; Punt!
 315                 (beginning-of-defun)
 316                 (setq pos (point)))))
 317            ((= pos 0))
 318            ((not (eq (char-after pos) ?{))
 319             (goto-char pos)
 320             (setq pos nil))
 321            ))
 322         (goto-char pos))
 323     ;; Emacs, which doesn't have buffer-syntactic-context-depth
 324     (beginning-of-defun))
 325   ;; if defun-prompt-regexp is non-nil, b-o-d won't leave us at the
 326   ;; open brace.
 327   (and defun-prompt-regexp
 328        (looking-at defun-prompt-regexp)
 329        (goto-char (match-end 0))))
 330
 331 (defsubst c-end-of-defun-1 ()
 332   ;; Replacement for end-of-defun that use c-beginning-of-defun-1.
 333   (let ((start (point)))
 334     ;; Skip forward into the next defun block. Don't bother to avoid
 335     ;; comments, literals etc, since beginning-of-defun doesn't do that
 336     ;; anyway.
 337     (skip-chars-forward "^}")
 338     (c-beginning-of-defun-1)
 339     (if (eq (char-after) ?{)
 340         (c-forward-sexp))
 341     (if (< (point) start)
 342         (goto-char (point-max)))))
 343
 344 (defsubst c-intersect-lists (list alist)
 345   ;; return the element of ALIST that matches the first element found
 346   ;; in LIST.  Uses assq.
 347   (let (match)
 348     (while (and list
 349                 (not (setq match (assq (car list) alist))))
 350       (setq list (cdr list)))
 351     match))
 352
 353 (defsubst c-lookup-lists (list alist1 alist2)
 354   ;; first, find the first entry from LIST that is present in ALIST1,
 355   ;; then find the entry in ALIST2 for that entry.
 356   (assq (car (c-intersect-lists list alist1)) alist2))
 357
 358 (defsubst c-langelem-col (langelem &optional preserve-point)
 359   ;; convenience routine to return the column of langelem's relpos.
 360   ;; Leaves point at the relpos unless preserve-point is non-nil.
 361   (if (cdr langelem)
 362       (let ((here (point)))
 363         (goto-char (cdr langelem))
 364         (prog1 (current-column)
 365           (if preserve-point
 366               (goto-char here))
 367           ))
 368     0))
 369
 370 (defsubst c-keep-region-active ()
 371   ;; Do whatever is necessary to keep the region active in XEmacs.
 372   ;; This is not needed for Emacs.
 373   (and (boundp 'zmacs-region-stays)
 374        (setq zmacs-region-stays t)))
 375
 376 (defsubst c-region-is-active-p ()
 377   ;; Return t when the region is active.  The determination of region
 378   ;; activeness is different in both Emacs and XEmacs.
 379   (cond
 380    ;; XEmacs
 381    ((and (fboundp 'region-active-p)
 382          (boundp 'zmacs-regions)
 383          zmacs-regions)
 384     (region-active-p))
 385    ;; Emacs
 386    ((boundp 'mark-active) mark-active)
 387    ;; fallback; shouldn't get here
 388    (t (mark t))))
 389
 390 (defsubst c-major-mode-is (mode)
 391   (eq c-buffer-is-cc-mode mode))
 392
 393 \f
 394 (cc-provide 'cc-defs)
 395
 396 ;;; cc-defs.el ends here