pjb-objc-ide.el

;;;; -*- mode:emacs-lisp; coding:utf-8; lexical-binding:t -*-
;;;;**************************************************************************
;;;;FILE:               pjb-objc-ide.el
;;;;LANGUAGE:           emacs lisp
;;;;SYSTEM:             POSIX
;;;;USER-INTERFACE:     NONE
;;;;DESCRIPTION
;;;;
;;;;    Some Objective-C refactoring tools.
;;;;
;;;;AUTHORS
;;;;    <PJB> Pascal Bourguignon <pbourguignon@dxo.com>
;;;;MODIFICATIONS
;;;;    2013-01-22 <PJB> Created.
;;;;BUGS
;;;;LEGAL
;;;;    AGPL3
;;;;
;;;;    Copyright Pascal Bourguignon 2013 - 2013
;;;;
;;;;    This program is free software: you can redistribute it and/or modify
;;;;    it under the terms of the GNU Affero General Public License as published by
;;;;    the Free Software Foundation, either version 3 of the License, or
;;;;    (at your option) any later version.
;;;;
;;;;    This program 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 Affero General Public License for more details.
;;;;
;;;;    You should have received a copy of the GNU Affero General Public License
;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;;;**************************************************************************
(require 'cl)
(require 'cedet)
(require 'pjb-strings)
(require 'pjb-emacs)
(require 'pjb-objc-parser)


(defvar *pjb-objc-ide--nslog-function* "NSLog"
  "The Objective-C function to us to log messages.
It should have the same signature as NSLog.")

(defvar *pjb-objc-ide--entry-log-tag* "DEBUG"
  "A tag that will be put in comment on the lines inserted by
`pjb-objc-ide--add-method-entry-log'.")



(defun pjb-objc-ide--ns-class-type-p (type)
  ;; TODO: It would be better to collect the exact list of NS classes…
  (and (listp type)
       (eq (second type) '*)
       (null (cddr type))
       (symbolp (first type))
       (string= "NS" (substring (symbol-name (first type)) 0 2))))



(defun pjb-objc-ide--rect-formatter-arguments (argument)
  (mapcar (lambda (fmt) (intern (format fmt argument)))
          '("%s.origin.x" "%s.origin.y" "%s.size.width" "%s.size.height")))

(defun pjb-objc-ide--point-formatter-arguments (argument)
  (mapcar (lambda (fmt) (intern (format fmt argument)))
          '("%s.x" "%s.y")))

(defun pjb-objc-ide--size-formatter-arguments (argument)
  (mapcar (lambda (fmt) (intern (format fmt argument)))
          '("%s.width" "%s.height")))

(defun pjb-objc-ide--range-formatter-arguments (argument)
  (mapcar (lambda (fmt) (intern (format fmt argument)))
          '("%s.location" "%s.length")))


(defparameter *pjb-objc-ide--type-formatter-map*
  '(((NSUInteger)                  . "%d")
    ((NSInteger)                   . "%d")
    ((BOOL)                        . "%d")
    ((CGFloat)                     . "%f")
    ((int)                         . "%d")
    ((unsigned)                    . "%u")
    ((unsigned int)                . "%u")
    ((char)                        . "%c")
    ((char *)                      . "%s")
    ((const char *)                . "%s")
    ((id)                          . "%@")
    ((NSRange)                     . ("{l=%d,c=%d}" pjb-objc-ide--range-formatter-arguments))
    ((NSPoint)                     . ("{x=%f,y=%f}" pjb-objc-ide--point-formatter-arguments))
    ((NSSize)                      . ("{w=%f,h=%f}" pjb-objc-ide--size-formatter-arguments))
    ((NSRect)                      . ("{{x=%f,y=%f},{w=%f,h=%f}}" pjb-objc-ide--rect-formatter-arguments))
    (pjb-objc-ide--ns-class-type-p . "%@"))
  "A list of conses.

The car slots are lists representing Objective-C types,
or a predicate name to be called to match the type.

The cdr slots are NSLog formatters: either a string to be inserted
into the formatter string of NSLog, or a list containing a formatter
string, and a function to build a list of arguments to NSLog for this
formatter string, from the expression to be formatted.
")


(defun pjb-objc-ide--formatter-for-type (type)
  (loop
     for (type-match . formatter) in *pjb-objc-ide--type-formatter-map*
     do (when (if (and (atom type-match)
                       (fboundp type-match))
                  (funcall type-match type)
                  (equal type-match type))
          (return formatter))
     finally (return (cond
                       ((and (atom type) (char= ?* (last-char (ensure-string type))))
                        (pjb-objc-ide--formatter-for-type (list (intern (butlast-char (ensure-string type))) '*)))
                       ((and (listp type) (null (rest type)) (atom (first type))
                              (char= ?* (last-char (ensure-string (first type)))))
                        (pjb-objc-ide--formatter-for-type (list (intern (butlast-char (ensure-string (first type)))) '*)))
                       (t
                        nil)))))

(assert (equal (mapcar 'pjb-objc-ide--formatter-for-type
                 '((NSInteger) (NSUInteter) (BOOL) (char) (char *) (const char *) (id)
                   (NSString *) (NSMutableString *) (NSDictionary *) (NSMutableArray *)
                   (something *) (something) NSArray* (NSArray*)))
               '("%d" nil "%d" "%c" "%s" "%s" "%@" "%@" "%@" "%@" "%@" nil nil "%@" "%@")))



(defun pjb-objc-ide--princ-to-string (x)
  (let ((print-circle nil))
    (format "%s" x)))


(defun pjb-objc-ide--process-method (processor &optional count)
  "Process method implementations.

If `count' is negative then processes all the implementation methods
from the point down to the end of the buffer, otherwise process the
given number of methods (default 1).

Calls the function `processor' with as arguments, the method
signature, the start point and end point of the body region (including
braces), and with the current point before the opening brace (=
start-pt).

The excursion is saved while running `processor'.
"
  (loop
     with count = (or count 1)
     for i from 0
     while (or (minusp count) (< i count))
     do
       (incf i)
       (c-forward-comments)
       (if (re-search-forward "\\(\\s-\\|\n\\)*[-+]\\(\\s-\\|\n\\)*(" nil t)
           (progn
             (goto-char (match-beginning 0))
             (let ((signature (pjb-objc-parser--parse-method-signature)))
               (when (looking-at "\\(\\s-\\|\n\\)*{")
                 (forward-sexp)
                 (let ((end-pt (point)))
                   (backward-sexp)
                   (save-excursion
                     (funcall processor signature (point) end-pt))))))
           (return))))


(defun pjb-objc-ide--insert-tag ()
  "Insert a tag comment on a newline."
  (insert (format "  /*** %s ***/ " *pjb-objc-ide--entry-log-tag*)))


(defun pjb-objc-ide--insert-method-entry-log (&optional count)
    "Insert a logging statement at the entry of the objective-c method dumping the parameters.

If `count' is negative then processes all the implementation methods
from the point down to the end of the buffer, otherwise process the
given number of methods (default 1).

The excursion is saved.
"
  (interactive "p")
  (let ((nil-types '()))
    (pjb-objc-ide--process-method
     (lambda (signature start-pt end-pt)
       (down-list)
       (insert "\n")
       (pjb-objc-ide--insert-tag)
       (insert (format "%s(@\"%%s" *pjb-objc-ide--nslog-function*))
       (let ((formatter-parameters '()))
         (dolist (param (cons (pjb-objc-parameter :name 'self :type '(id))
                              (pjb-objc-method-signature-parameters signature)))
           (let* ((type      (pjb-objc-parameter-type param))
                  (formatter (pjb-objc-ide--formatter-for-type type)))
             (if formatter
                 (let ((args      (if (listp formatter)
                                      (funcall (second formatter) (pjb-objc-parameter-name param))
                                      (list (pjb-objc-parameter-name param))))
                       (formatter (if (listp formatter)
                                      (first formatter)
                                      formatter)))
                   (push (cons (pjb-objc-parameter-name param) args) formatter-parameters)
                   (insert (format ", %%@ = %s" formatter)))
                 (pushnew type nil-types :test (function equal)))))
         (insert "\", __PRETTY_FUNCTION__")
         (dolist (param (reverse formatter-parameters))
           (insert (format ", @\"%s\", %s"
                           (car param)
                           (mapconcat (function pjb-objc-ide--princ-to-string) (cdr param)  ", ")))))
       (insert ");"))
     count)
    (when nil-types
      (message "Objective-C types without a formatter (see `*pjb-objc-ide--type-formatter-map*'): %S"
               nil-types))))



(defun pjb-objc-ide--insert-method-return-log (&optional count)
      "Insert a logging statement before each return statement in the objective-c method dumping the returned result.

If `count' is negative then processes all the implementation methods
from the point down to the end of the buffer, otherwise process the
given number of methods (default 1).

The excursion is saved.
"
  (interactive "p")
  (let ((nil-types '()))
    (pjb-objc-ide--process-method
     (lambda (signature start-pt end-pt)
       ;; We assume return statements are never left alone, but are
       ;; always in a block.  Therefore we can insert before them as
       ;; many statements we want, including another return statement.
       ;;
       ;; {
       ;;     return a+b;
       ;; }
       ;; -->
       ;; {
       ;;     /*** TAG ***/ ResultTypeFromMethodSignature result=a+b;
       ;;     /*** TAG ***/ NSLog(@"%p returns %d", __PRETTY_FUNCTION__, result);
       ;;     /*** TAG ***/ return result;
       ;;     return a+b;
       ;; }
       (with-marker (end-pt end-pt)
         (loop
            while (re-search-forward "^\\s-*return \\([^;]*\\);" end-pt t)
            do
              (with-marker (mend (match-end 0))
                (let ((result-type (pjb-objc-method-signature-result-type signature))
                      (result-variable (gensym "result_"))
                      (result-expression (match-string 1)))
                  (goto-char (match-beginning 0))
                  (pjb-objc-ide--insert-tag) (insert (format "%s %s=%s;\n"
                                                             (mapconcat (function pjb-objc-ide--princ-to-string) result-type " ")
                                                             result-variable
                                                             result-expression))
                  (pjb-objc-ide--insert-tag) (insert (format "%s(@\"%%s returns "
                                                             *pjb-objc-ide--nslog-function*))
                  (let ((formatter (pjb-objc-ide--formatter-for-type result-type)))
                    (if formatter
                        (let ((results   (if (listp formatter)
                                             (funcall (second formatter) result-variable)
                                             (list result-variable)))
                              (formatter (if (listp formatter)
                                             (first formatter)
                                             formatter)))
                          (insert (format "%s\", __PRETTY_FUNCTION__, %s"
                                          formatter

                                          (mapconcat (function pjb-objc-ide--princ-to-string) results  ", "))))
                        (progn
                          (insert (format "<%s>\", __PRETTY_FUNCTION__"
                                          result-type))
                          (pushnew result-type nil-types :test (function equal)))))
                  (insert ");\n")
                  (pjb-objc-ide--insert-tag) (insert (format "return %s;\n" result-variable)))
                (goto-char mend)))))
     count)
    (when nil-types
      (message "Objective-C types without a formatter (see `*pjb-objc-ide--type-formatter-map*'): %S"
               nil-types))))



(defun pjb-objc-ide-synthesize-properties ()
  "Replace all @property <type> <identifier>; lines by @synthesize <identifier>; lines."
  ;; TODO: The right thing would be to search all properties in class
  ;;       headers and superclasses headers, and to synthesize those
  ;;       that need to be synthesized, depending of the @property
  ;;       declaration and the presence of methods in the source
  ;;       files...
  (interactive)
  (goto-char (point-min))
  (while (re-search-forward "^[ \t]*@property\\>.*\\(\\<[_A-Za-z][_A-Za-z0-9]*\\)[ \t\n]*;" (point-max) t)
    (let ((name (match-string 1)))
     (delete-region (match-beginning 0) (match-end 0))
     (insert (format "@synthesize %s;" name)))))



(defun pjb-objc-ide-beginning-of-class ()
  (interactive)
  (when (re-search-backward "@\\(\\(interface\\|implementation\\|prototype\\) +\\([A-Za-z0-9_]+\\)\\|end\\)" nil t)
    (goto-char (match-beginning 0))))

(defun pjb-objc-ide-current-class ()
  (save-excursion
   (when (re-search-backward "@\\(\\(interface\\|implementation\\|prototype\\) +\\([A-Za-z0-9_]+\\)\\|end\\)" nil t)
     (let ((token (match-string 2))
           (name  (match-string 3)))
       (and token name)))))


(defun pjb-objc-ide-current-superclass ()
  (save-window-excursion
    (save-excursion
      (when (re-search-backward "@\\(\\(\\(interface\\|implementation\\|prototype\\) +\\([A-Za-z0-9_]+\\)\\( *: *\\([A-Za-z0-9_]+\\)\\)?\\)\\|end\\)" nil t)
        (let ((token (match-string 3))
              (name  (match-string 4))
              (super (match-string 6)))
          (when token
            (or super
                ;; TODO: search all @interface/@implementation/@prototype
                ;;       in the current file, in pjb-thi-other-file, and
                ;;       in all the files in the same directory.
                (progn
                  ;; Quick and dirty:
                  (toggle-header/implementation)
                  (goto-char (point-min))
                  (when (re-search-forward (format "@interface +%s *: *\\([A-Za-z0-9_]+\\)" name) nil t)
                    (match-string 1))))))))))

(defun pjb-objc-ide-find-superclass-file ()
  (interactive)
  (let ((superclass (pjb-objc-ide-current-superclass)))
    (when superclass
      (message "superclass = %s" superclass)
      (sources-find-file-named (format "%s.h" superclass))
      (goto-char (point-min))
      (re-search-forward (format "@interface +%s" superclass) nil t))))




(defun insert-braces (&optional arg)
  "Enclose following ARG sexps in braces.
Leave point after open-paren.
A negative ARG encloses the preceding ARG sexps instead.
No argument is equivalent to zero: just insert `{}' and leave point between.
If `parens-require-spaces' is non-nil, this command also inserts a space
before and after, depending on the surrounding characters.
If region is active, insert enclosing characters at region boundaries.

This command assumes point is not in a string or comment."
  (interactive "P")
  (insert-pair arg ?\{ ?\}))


(defun pjb-ide-beginning-of-line-to-point ()
  (buffer-substring (save-excursion
                      (beginning-of-line)
                      (point))
                    (point)))

(defun pjb-ide-tag-comment (tag)
  (case tag
     ((1)        "/*** PJB-DEBUG ***/")
     ((-1)       "//*** PJB-DISABLED ***//")
     (otherwise  "/*** PJB ***/")))

(defun pjb-ide-insert-tag-comment (&optional tag)
  (interactive "p")
  (let ((tag   (or tag 0)))
    (unless (string= "" (cl:string-trim " \t" (pjb-ide-beginning-of-line-to-point)))
      (insert "\n"))
    (if (region-active-p)
        (let ((start (region-beginning))
              (end   (region-end)))
          (message  "tag=%S start=%S end=%S" tag start end)
          (goto-char start)
          (with-marker (end end)
            (while (< (point) end)
              (insert (pjb-ide-tag-comment tag))
              (beginning-of-line 2))))
        (insert (pjb-ide-tag-comment tag)))))


(defun pjb-ide-insert-documentation-comment ()
  (interactive)
  (insert "
/**
 *
 *
 *
 */
"))


(provide 'pjb-objc-ide)