pjb-c.el

;;;; -*- mode:emacs-lisp;coding:utf-8 -*-
;;;;******************************************************************************
;;;;FILE:               pjb-c.el
;;;;LANGUAGE:           emacs lisp
;;;;SYSTEM:             emacs
;;;;USER-INTERFACE:     emacs
;;;;DESCRIPTION
;;;;
;;;;    This module exports C indenting functions.
;;;;
;;;;AUTHORS
;;;;    <PJB> Pascal J. Bourguignon
;;;;MODIFICATIONS
;;;;    2003-02-25 <PJB> Updated, from pjb-objc-mode.el, for emacs 21.2.
;;;;    199?-??-?? <PJB> Creation.
;;;;BUGS
;;;;LEGAL
;;;;    LGPL
;;;;
;;;;    Copyright Pascal J. Bourguignon 1990 - 2011
;;;;
;;;;    This library is free software; you can redistribute it and/or
;;;;    modify it under the terms of the GNU Lesser General Public
;;;;    License as published by the Free Software Foundation; either
;;;;    version 2 of the License, or (at your option) any later version.
;;;;
;;;;    This library is distributed in the hope that it will be useful,
;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;;    Lesser General Public License for more details.
;;;;
;;;;    You should have received a copy of the GNU Lesser General Public
;;;;    License along with this library; if not, write to the Free Software
;;;;    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
;;;;
;;;;******************************************************************************
(debug "Should not load this file!")
(provide 'pjb-c)
(require 'cc-mode)
(require 'pjb-utilities)
(error "should not be loaded...")


(defun pjb-c-syntax-of-previous-line ()
  "
RETURN: the syntax (in c-guess-basic-syntax sense) of the previous line.
"
  (save-excursion
    (forward-line -1)
    (end-of-line)
    (c-guess-basic-syntax))
  );;pjb-c-syntax-of-previous-line


(defun pjb-c-comment-of-method    (syntcont)
  "
RETURN: whether the previous line is a objc-method-intro
        and the current line is a comment-intro.
"
  (and (eq (caar (pjb-c-syntax-of-previous-line)) 'objc-method-intro)
       (eq (caar syntcont)                        'comment-intro))
  );;pjb-c-comment-of-method


(defun pjb-c-comment-of-function  (syntcont)
  "
RETURN: whether the current syntactic context is
            ((comment-intro) (knr-argdecl-intro . N))
"
  (and (= (length syntcont) 2)
       (eq (caar syntcont) 'comment-intro)
       (or (eq (caadr  syntcont) 'knr-argdecl-intro)
           (eq (caadr  syntcont) 'objc-method-args-cont)))
  );;pjb-c-comment-of-function


(defun pjb-c-comment-of-top-level (syntcont)
  "
RETURN: whether the current syntactic context is
            ((comment-intro) (topmost-intro . N))
"
  (and (= (length syntcont) 2)
       (eq (caar  syntcont) 'comment-intro)
       (eq (caadr syntcont) 'topmost-intro))
  );;pjb-c-comment-of-top-level


(defun pjb-c-previous-line-is-//-comment ()
  "
RETURN: whether the previous line is a // comment.
"
  (save-excursion
    (forward-line -1)
    (back-to-indentation)
    (looking-at "//"))
  );;pjb-c-previous-line-is-//-comment


(defun pjb-c-current-line-is-//-comment ()
  "
RETURN: whether the current line is a // comment.
"
  (save-excursion
    (back-to-indentation)
    (looking-at "//"))
  );;pjb-c-current-line-is-//-comment


(defun pjb-c-current-line-is-/*-comment ()
  "
RETURN: whether the current line is a /* comment.
"
  (save-excursion
    (back-to-indentation)
    (looking-at "/[*]"))
  );;pjb-c-current-line-is-/*-comment


(defun pjb-c-beginning-of-comment ()
  "
PRE:    (point) is inside a comment.
DO:     Move the point at the beginning of the comment.
"
  (interactive)
  (let* ((syntax  (c-guess-basic-syntax))
         (boc     (assoc 'c syntax)))
    (while boc
      (forward-line -1)
      (pjb-c-beginning-of-comment)
      (setq syntax  (c-guess-basic-syntax)
            boc     (assoc 'c syntax)))
    (if (eq (caar syntax) 'comment-intro)
        (back-to-indentation)
      (error "We must start from the inside of a comment!")))
  );;pjb-c-beginning-of-comment


(defun pjb-c-first-line-of-comment (syntcont)
  "
RETURN: whether the current line is on the first line of a comment,
        discounting the comment-intro on the previous line.
EXAMPLES:
     // YES comment-intro  /* NO  comment-intro  /*    NO  comment-intro
     // NO  comment-intro     YES c                 // YES comment-intro c
     // NO  comment-intro     NO  c                 // NO  comment-intro c
     // NO  comment-intro  */ NO  c              */    NO  c
"
  (let ((boc (assoc 'c syntcont))
        (curr-point (save-excursion (beginning-of-line) (point))))
    (save-excursion
      (if boc
        ;; within a /* comment.
        (progn
          (pjb-c-beginning-of-comment)
          (and (= (point) (cdr boc))
               (= 1 (count-lines (point) curr-point))))
        ;; within a range of // comments.
        (and (pjb-c-current-line-is-//-comment)
             (not (pjb-c-previous-line-is-//-comment))))))
  );;pjb-c-first-line-of-comment



(defun pjb-c-really-comment-intro (syntcont)
  "
RETURN: whether the given syntcont is really a comment intro, and not a mere
        // comment following a // comment or a comment inside a /* comment.
"
  (and (eq (caar syntcont) 'comment-intro)
       (not (assoc 'c syntcont)))
  );;pjb-c-really-comment-intro


(defun pjb-c-keyword-comment-line (syntcont)
  "
RETURN:         Wether we're in a ''KEYWORD:  comment'' line.
"
  (let ((result (progn
  (back-to-indentation)
  (let ((case-fold-search nil))
    (looking-at "[A-Z][-A-Z ]*[A-Z]: "))
  ))) (message "c-keyword-comment=%S" result) result)
  );;pjb-c-keyword-comment-line


(defvar pjb-c-keyword-comment-indent 16
  "Indentation of keyworded comments.");;pjb-c-keyword-comment-indent


(defun pjb-c-lineup-C-comments (langelem)
  "
PRE:            langelem = (comment-intro) or langelem = (c . N)
NOTE:           When langelem = (comment-intro), we're on the line '/*',
                when langelem = (c . N), we're inside the comment.
RETURN:         The relative indentation of the following line.
SEE ALSO:       c-indent-line
"
  (save-excursion
    (let ((c-syntactic-context (c-guess-basic-syntax)))
      (message "\n(c-guess-basic-syntax)=%S\nc-syntactic-context=%S\nlangelem=%S" (c-guess-basic-syntax) c-syntactic-context langelem)
      (if (pjb-c-really-comment-intro c-syntactic-context)
        (progn
          (message "really-comment-intro")
          ;; The indentation for "/*" depends on the previous line.
          (cond
           ((or (pjb-c-comment-of-method    c-syntactic-context)
                (pjb-c-comment-of-function  c-syntactic-context)
                (pjb-c-comment-of-top-level c-syntactic-context))
            (- c-basic-offset))
           (t
            0))
          )
        (progn
          (message "Body or end of comment")
          ;; Body or end of comment.
          (back-to-indentation)
          (cond
           ((looking-at "[*]+/")
            ;; The indentation of "*/" is the same as the indentation of "/*".
            (message "at end of comment")
            (goto-char (match-end 0))
            (forward-comment -1)
            0) ;;(- (current-column) (c-langelem-col langelem)))
           ((pjb-c-first-line-of-comment c-syntactic-context)
            (message "first line of comment")
            c-basic-offset)
           (t
            ;; The indentation of the other lines of the comment
            ;; is the same as that of the previous line.
            ;; TODO: We should check if the previous lines begins
            ;;       with a keyword.
            ;;         EXEMPLE:        comment tralala
            ;;                         comment tralala
            (message "In middle of comment")
            (cond
             ((pjb-c-keyword-comment-line c-syntactic-context)
              (message "keyword line")
              c-basic-offset)
             ((save-excursion
                (forward-line -1)
                (pjb-c-keyword-comment-line c-syntactic-context))
              (message "just after keyword line")
              (+ c-basic-offset pjb-c-keyword-comment-indent))
             (t
              (message "other comment line")
              ;; same indentation as previous line.
              (save-excursion
                (forward-line -1)
                (back-to-indentation)
                (- (current-column) (c-langelem-col langelem))) ))))))))
  );;pjb-c-lineup-C-comments



(defconst pjb-c-todo-regexp
  "\\(\\(//\\)? *\\(TODO\\|SEE\\):.*\\|/\\* *\\(TODO\\|SEE\\):\\(\\*[^/]\\|[^\\*]\\)* \\*/\\)"
  "regexp to match a TODO: (obsolete SEE:) comment.");;pjb-c-todo-regexp


(defun pjb-c-todo-hook ()
 "A hook for C-like modes to add specific font-lock to TODO comments."
  (font-lock-add-keywords
   major-mode (list (list pjb-c-todo-regexp 1 'font-lock-warning-face t))))


;; (defconst pjb-c-C++-method-key
;;   (concat
;;    "^\\s *"
;;    "\\(ABSTRACTMETHOD\\|CLASSMETHOD\\|METHOD"
;;    "\\|PROCEDURE\\|CONSTRUCTOR2?\\|DESTRUCTOR\\)"
;;    "([^)]*\\(([^)]*)\\)?[^)]*)\\s *"))
;;
;;
;; (defun pjb-c++-mode-hook ()
;;   "A hook for C++ mode where we install our own pjb-c-C++-method-key."
;;   (setq c-method-key pjb-c-C++-method-key))




;;; (setq tab-width                     4)  ; the true one!

;;; (setq c-indent-level                4) ;  Indentation of C statements with
;;;                                         ; respect to containing block.

;;; (setq c-brace-imaginary-offset      0) ;  Imagined indentation of a C open brace
;;;                                         ; that actually follows a statement.

;;; (setq c-brace-offset                0) ;  Extra indentation for braces, compared
;;;                                         ; with other text in same context.

;;; (setq c-argdecl-indent              4) ;  Indentation level of declarations of
;;;                                         ; C function arguments.

;;; (setq c-label-offset               -4) ;  Offset of C label lines and case
;;;                                         ; statements relative to usual
;;;                                         ; indentation.

;;; (setq c-continued-statement-offset  4) ;  Extra indent for lines not starting
;;;                                         ; new statements.

;;; (setq c-continued-brace-offset      0) ;  Extra indent for substatements that
;;;                                         ; start with open-braces.

;;; (setq c-basic-offset                4) ;  Amount of basic offset used by `+' and
;;;                                         ; `-' symbols in `c-offsets-alist'.

;;; (setq c-auto-newline                nil) ; Non-nil means automatically newline
;;;                                         ;  before and after braces, and after
;;;                                         ;  colons and semicolons, inserted in C
;;;                                         ;  code. If you do not want a leading
;;;                                         ;  newline before braces then use:
;;;                                         ;  (define-key c-mode-map \"{\"
;;;                                         ;           'electric-c-semi)"

;;; (setq c-tab-always-indent           nil) ; Non-nil means TAB in C mode should
;;;                                         ;  always reindent the current line,
;;;                                         ;  regardless of where in the line point
;;;                                         ;  is when the TAB command is used.


(defvar *pjb-c-word-size* 64 "Number of bits in a unsigned long long.")
(defun pjb-c-label-function (name enum-type enum-constants)
  (let* ((word-size   64)
         (max-width   (loop for constant in enum-constants
                            maximize (length (prin1-to-string constant))))
         (case-format (format "    case %%-%ds: return %%S;\n" max-width))
         (buffer-size (+ (length "Invalid  value: ")
                         (length (prin1-to-string enum-type))
                         (ceiling (* *pjb-c-word-size* (log 2 10)))
                         1 ; terminating null
                         16 ; safety.
                         )))
    (concat (format "const char* %s(%s value){
    switch(value){
" name enum-type)
            (mapconcat (lambda (constant) (format case-format constant (prin1-to-string constant)))
                       enum-constants "")
            (format "    default: {
        static char buffer[%d];
        sprintf(buffer,\"Invalid %s value: %%d\",value);
        return buffer;
    }}
}
" buffer-size enum-type))))


(assert (string= (pjb-c-label-function 'get_label 'foo '(foo_foo foo_bar foo_chiang))
         "const char* get_label(foo value){
    switch(value){
    case foo_foo   : return \"foo_foo\";
    case foo_bar   : return \"foo_bar\";
    case foo_chiang: return \"foo_chiang\";
    default: {
        static char buffer[56];
        sprintf(buffer,\"Invalid foo value: %d\",value);
        return buffer;
    }}
}
"))



(defun ensure-string (object)
  (typecase object
    (symbol (symbol-name object))
    (string object)
    (t (prin1-to-string object))))

(defun substitute-strings (substitutions string)
  (with-temp-buffer
      (loop
        for (old new) in substitutions
          initially (insert string)
        do (replace-string (ensure-string old)
                           (ensure-string new)
                           nil (point-min) (point-max))
        finally (return (buffer-substring-no-properties (point-min) (point-max))))))

(when nil
  (progn
    (loop
      for <T> in '("A" "W")
      for TCHAR in '("char" "WCHAR")
      do (insert (substitute-strings (list (list '<T> <T>) (list 'TCHAR TCHAR))
                                 "
BOOL contains<T> (TCHAR * string, char * substring)
{
    int wlen = strlen<T>(string);
    int slen = strlen(substring);
    int end = wlen - slen;
    int i = 0;
    for (i = 0; i < end; i ++ )
    {
        if (ncompare<T>(string + i, substring, slen) == 0)
        {
            return TRUE;
        }
    }
    return FALSE;
}
")))
    (insert "
BOOL contains (int widechar, BYTE * string, char * substring)
{
    if (widechar)
    {
        return containsW((WCHAR*)string,substring);
    }
    else
    {
        return containsA((char*)string,substring);
    }
}
")))


;;;; THE END ;;;;