;;;; -*- mode:emacs-lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE:               pjb-objc-edit.el
;;;;LANGUAGE:           emacs lisp
;;;;SYSTEM:             POSIX
;;;;USER-INTERFACE:     NONE
;;;;DESCRIPTION
;;;;
;;;;    A few utilities to help editing Objective-C++ code with
;;;;    strange style rules.
;;;;
;;;;AUTHORS
;;;;    <PJB> Pascal Bourguignon <pbourguignon@dxo.com>
;;;;MODIFICATIONS
;;;;    2012-11-15 <PJB> Created.
;;;;BUGS
;;;;LEGAL
;;;;    AGPL3
;;;;
;;;;    Copyright Pascal Bourguignon 2012 - 2012
;;;;
;;;;    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 'cc-mode)
(require 'semantic)
(require 'pjb-objc-ide)
(require 'paredit)

(defparameter pjb-objc-edit--*c++-operators*
  '((1 :left-to-right                     ;  highest
     (2 :infix  "::"                    "Scope resolution (C++ only)"))
    (2 :left-to-right
     (1 :suffix "++"                    "Suffix increment")
     (1 :suffix "--"                    "Suffix decrement")
     (2 :infix  "()"                    "Function call")
     (2 :infix  "[]"                    "Array subscripting")
     (2 :infix  "."                     "Element selection by reference")
     (2 :infix  "->"                    "Element selection through pointer")
     (1 :prefix "typeid()"              "Run-time type information (C++ only) (see typeid)")
     (2 :prefix "const_cast"            "Type cast (C++ only) (see const cast)")
     (2 :prefix "dynamic_cast"          "Type cast (C++ only) (see dynamic_cast)")
     (2 :prefix "reinterpret_cast"      "Type cast (C++ only) (see reinterpret cast)")
     (2 :prefix "static_cast"           "Type cast (C++ only) (see static cast)"))
    (3 :right-to-left
     (1 :prefix "++"                    "Prefix increment" )
     (1 :prefix "--"                    "Prefix decrement")
     (1 :prefix "+"                     "Unary plus")
     (1 :prefix "-"                     "Unary minus")
     (1 :prefix "!"                     "Logical NOT")
     (1 :prefix "~"                     "Bitwise NOT")
     (2 :infix  "(type)"                "Type cast")
     (1 :prefix "*"                     "Indirection (dereference)")
     (1 :prefix "&"                     "Address-of")
     (1 :prefix "sizeof"                "Size-of")
     (1 :prefix "new"                   "Dynamic memory allocation (C++ only)")
     (2 :infix  "new[]"                 "Dynamic memory allocation (C++ only)")
     (1 :prefix "delete, delete[]"      "Dynamic memory deallocation (C++ only)"))
    (4 :left-to-right
     (2 :infix  ".*"                    "Pointer to member (C++ only)")
     (2 :infix  "->*"                   "Pointer to member (C++ only)"))
    (5 :left-to-right
     (2 :infix  "*"                     "Multiplication")
     (2 :infix  "/"                     "Division")
     (2 :infix  "%"                     "Modulo (remainder)"))
    (6 :left-to-right
     (2 :infix  "+"                     "Addition")
     (2 :infix  "-"                     "Subtraction"))
    (7 :left-to-right
     (2 :infix  "<<"                    "Bitwise left shift")
     (2 :infix  ">>"                    "Bitwise right shift"))
    (8 :left-to-right
     (2 :infix  "<"                     "Less than")
     (2 :infix  "<="                    "Less than or equal to")
     (2 :infix  ">"                     "Greater than")
     (2 :infix  ">="                    "Greater than or equal to"))
    (9 :left-to-right
     (2 :infix  "=="                    "Equal to")
     (2 :infix  "!="                    "Not equal to"))
    (10 :left-to-right
     (2 :infix  "&"                    "Bitwise AND"))
    (11 :left-to-right
     (2 :infix  "^"                    "Bitwise XOR (exclusive or)"))
    (12 :left-to-right
     (2 :infix  "|"                    "Bitwise OR (inclusive or)"))
    (13 :left-to-right
     (2 :infix  "&&"                   "Logical AND"))
    (14 :left-to-right
     (2 :infix  "||"                   "Logical OR"))
    (15 :right-to-left
     (3 :infix "?:"                    "Ternary conditional (see ?:)" )
     (2 :infix  "="                    "Direct assignment")
     (2 :infix  "+="                   "Assignment by sum")
     (2 :infix  "-="                   "Assignment by difference")
     (2 :infix  "*="                   "Assignment by product")
     (2 :infix  "/="                   "Assignment by quotient")
     (2 :infix  "%="                   "Assignment by remainder")
     (2 :infix  "<<="                  "Assignment by bitwise left shift")
     (2 :infix  ">>="                  "Assignment by bitwise right shift")
     (2 :infix  "&="                   "Assignment by bitwise AND")
     (2 :infix  "^="                   "Assignment by bitwise XOR")
     (2 :infix  "|="                   "Assignment by bitwise OR"))
    (16 :right-to-left
     (1 :prefix "throw"                "Throw operator (exceptions throwing, C++ only)"))
    (17 :left-to-right
     (2 :infix  ","                    "Comma")))
  "A list of operators grouped by priority level, highest priority first.
Each group is a list (level associativity . operators).
Each operator is a list: (arity position operator description).
associativity is (member :left-to-right :right-to-left)
position is (member :prefix :infix :suffix)
")


(defun pjb-objc-edit--special-character-operators ()
  "Return a list of operators made of special characters only."
  (loop
     with ops = '()
     for (level associativity . operators) in pjb-objc-edit--*c++-operators*
     do (loop for (arity position operator description) in operators
           do (when (notany (function alphanumericp) operator)
                (pushnew (list operator position) ops :test (function equalp))))
     finally (return (sort* ops (function >) :key (lambda (x) (length (first x)))))))


;; (pjb-objc-edit--special-character-operators)
;;
;; ((">>=" :infix) ("<<=" :infix) ("->*" :infix) ("|=" :infix) ("^=" :infix)
;;  ("&=" :infix) ("%=" :infix) ("/=" :infix) ("*=" :infix) ("-=" :infix)
;;  ("+=" :infix) ("?:" :infix) ("||" :infix) ("&&" :infix) ("!=" :infix)
;;  ("==" :infix) (">=" :infix) ("<=" :infix) (">>" :infix) ("<<" :infix)
;;  (".*" :infix) ("--" :prefix) ("++" :prefix) ("->" :infix) ("[]" :infix)
;;  ("()" :infix) ("--" :suffix) ("++" :suffix) ("::" :infix) ("," :infix)
;;  ("=" :infix) ("|" :infix) ("^" :infix) ("&" :infix) (">" :infix)
;;  ("<" :infix) ("-" :infix) ("+" :infix) ("%" :infix) ("/" :infix)
;;  ("*" :infix) ("&" :prefix) ("*" :prefix) ("~" :prefix) ("!" :prefix)
;;  ("-" :prefix) ("+" :prefix) ("." :infix))

;; (">>=" "<<=" "->*" "|=" "^=" "&=" "%=" "/=" "*=" "-=" "+=" "?:" "||"
;;  "&&" "!=" "==" ">=" "<=" ">>" "<<" ".*" "->" "[]" "()" "--" "++" "::"
;;  "," "=" "|" "^" ">" "<" "%" "/" "&" "*" "~" "!" "-" "+" ".")



(defparameter *spaces-around* '(">>=" "<<=" "->*" "|=" "^=" "&=" "%="
                                "/=" "*=" "-=" "+=" "||" "&&" "!="
                                "==" ">=" "<=" ">>" "<<" "=" "|" "^"
                                "&" ">" "<" "-" "+" "%" "/" "*"))
(defparameter *space-after*  '(","))
(defparameter *space-before* '())

(defparameter *newline-around* '("{" "}"))
(defparameter *newline-after*  '(";"))
(defparameter *newline-before* '())

(defun pjb-objc-edit-insert-spaces-around-operators (start end)
  (interactive "r")
  (with-marker (end end)
    (goto-char start)
    (let ((re (let* ((opchars (remove-duplicates (mapconcat (function identity) *spaces-around* "")))
                     (re (mapconcat (function regexp-quote) *spaces-around* "\\|")))
                (format "\\([^ %s]\\(%s\\)[^ %s]\\)\\|\\([^ %s]\\(%s\\) \\)\\|\\( \\(%s\\)[^ %s]\\)"
                        opchars re opchars
                        opchars re
                        re opchars))))
      (while (re-search-forward re end t nil)
        (cond
          ((match-beginning 1)
           (goto-char (match-end 2))
           (insert " ")
           (goto-char (match-beginning 2))
           (insert " ")
           (goto-char (match-end 1)))
          ((match-beginning 3)
           (goto-char (match-beginning 4))
           (insert " ")
           (goto-char (match-end 3)))
          ((match-beginning 5)
           (goto-char (match-end 6))
           (insert " ")))))
    (goto-char start)
    (let ((re (format " *\\(%s\\) *" (mapconcat (function regexp-quote) *space-after* "\\|"))))
      (while (re-search-forward re end t nil)
        (replace-match (format "%s " (match-string 1)))))))





(defun pjb-objc-edit-insert-special-character (n)
  (interactive "P")
  (error "Not implemented yet")
  (cond
    ((listp n)    (self-insert-command n))
    ((integerp n) (self-insert-command n))
    (t

     (let ((before (char-before)))
       (cond
         ((member before '(32 9 10 13 nil))
          (insert (format "%c" last-command-char)))
         ((alphanumericp before)
          (insert (format " %c " last-command-char)))
         )
       )


     )))


(defun pjb-objc-edit-forward-sexp (&optional argument)
  (interactive "P")
  (if (and argument (minusp argument))
      (pjb-objc-edit-backward-sexp (- argument))
      (progn
        (forward-sexp)
        (backward-sexp)
        (if (looking-at "@\\(interface\\>\\|implementation\\>\\|protocol *[^(]\\)")
            (loop repeat (or argument 1)
               do (re-search-forward "^\\s-*@end\\>" nil t))
            (forward-sexp argument)))))


(defun pjb-objc-edit-backward-sexp (&optional argument)
  (interactive "P")
  (if (and argument (minusp argument))
      (pjb-objc-edit-forward-sexp (- argument))
      (let ((from (point)))
        (backward-sexp)
        (if (looking-at "@end\\>")
            (loop repeat (or argument 1)
               do (re-search-backward "@\\(interface\\>\\|implementation\\>\\|protocol *[^(]\\)" nil t)
               finally (goto-char (match-beginning 0)))
            (unless (or (null argument) (= 1 argument))
              (goto-char from)
              (backward-sexp argument))))))




(defun pjb-objc-kill-ring-save-selector ()
  (interactive)
  (cond
    ((looking-at "\\(\\s-\\|\n\\)*\\[")
     (let ((selector  (pjb-objc-selector-name (pjb-objc-message-send-selector  (pjb-objc-parser--parse-message-send)))))
       (kill-new selector)
       (message "Kill-ring'ed %S" selector)))
    ((looking-at "\\(\\s-\\|\n\\)*[-+]")
     (let ((selector  (pjb-objc-selector-name (pjb-objc-method-signature-selector (pjb-objc-parser--parse-method-signature)))))
       (kill-new selector)
       (message "Kill-ring'ed %S" selector)))
    (t
     (up-list)
     (backward-sexp)
     (pjb-objc-kill-ring-save-selector))))


(defun pjb-objc-edit-add-font-lock-keywords ()
  (interactive)
  ;; Try with overlays, not compose-region!
  ;; (font-lock-add-keywords
  ;;  nil
  ;;  '(("^ *# *pragma +mark +- *$"
  ;;     (0 (progn (compose-region (match-beginning 0) (match-end 0)
  ;;                               "/\\-"
  ;;                               'decompose-region)
  ;;               nil)))
  ;;    ("^ *# *pragma +mark +\\([^-].*\\) *$"
  ;;     (0 (progn (compose-region (match-beginning 0) (match-end 0)
  ;;                               "=!"
  ;;                               'decompose-region)
  ;;               nil)))))
  )



(defun pjb-objc-edit-convert-snail-to-camel (start end)
  (interactive "r")
  (goto-char start)
  (while (re-search-forward "_\\(.\\)" end t)
    (let ((ch (match-string 1)))
      (replace-match (string-upcase ch) t t))))

(defun pjb-objc-edit-convert-camel-to-snail (start end)
  (interactive "r")
  (goto-char start)
  (let ((case-fold-search nil))
   (while (re-search-forward "\\([a-z]\\)\\([A-Z]\\)" end t)
     (let ((ch1 (match-string 1))
           (ch2 (match-string 2)))
       (replace-match (format "%s_%s" ch1 (string-downcase ch2)) t t)))))


(defun pjb-objc-edit-electric-bracket-close ()
  (interactive)
  (let ((pt (point)))
    (backward-sexp 2)
    (insert "[")
    (goto-char (1+ pt))
    (insert "]")))

(defun pjb-objc-edit-space-for-delimiter-p (endp delimiter)
  (let ((result
         (let ((one-before (- (point) 1)))
           (not (and (not endp)
                     (<= (point-min) one-before)
                     (cond
                       ((char= ?\" delimiter)
                        (string= "@" (buffer-substring one-before (point))))
                       ((find delimiter "(){}[]")
                        (not (find (aref (buffer-substring one-before (point)) 0)
                                   ",(){}[]")))
                       (t nil)))))))
    (message "%s(%c) -> %s" 'pjb-objc-edit-space-for-delimiter-p delimiter result)
    result))

(defun pjb-objc-edit-doublequote (&optional n)
  (interactive "P")
  (let ((paredit-space-for-delimiter-predicates '(pjb-objc-edit-space-for-delimiter-p)))
    (paredit-doublequote n)))

(setf (get 'pjb-objc-edit-define-wrapper 'lisp-indent-function) 2)
(defmacro* pjb-objc-edit-define-wrapper (name paredit-function-name &body body)
  (let ((closep (search "-close-" (symbol-name paredit-function-name)))
        (lambda-list (help-function-arglist paredit-function-name)))
    `(defun ,name ,lambda-list
       ,(if (endp lambda-list) '(interactive) '(interactive "P"))
       (let ((saved (list (symbol-function 'paredit-in-string-p)
                          (symbol-function 'paredit-in-comment-p)))
             (paredit-space-for-delimiter-predicates '(pjb-objc-edit-space-for-delimiter-p)))
         (setf (symbol-function 'paredit-in-string-p)   (lambda (&rest ignored) (save-excursion (in-string-p)))
               (symbol-function 'paredit-in-comment-p)  (lambda (&rest ignored) (save-excursion (c-in-comment-line-prefix-p))))
         (unwind-protect
              (progn
                ,(if (endp lambda-list)
                     `(,paredit-function-name)
                     `(apply (function ,paredit-function-name) ,@(set-difference lambda-list '(&optional &key))))
                ,@body)
           (setf (symbol-function 'paredit-in-string-p)   (first saved)
                 (symbol-function 'paredit-in-comment-p)  (second saved)))))))

(pjb-objc-edit-define-wrapper pjb-objc-edit-open-round           paredit-open-round)
(pjb-objc-edit-define-wrapper pjb-objc-edit-close-round          paredit-close-round)
(pjb-objc-edit-define-wrapper pjb-objc-edit-open-square          paredit-open-square)
(pjb-objc-edit-define-wrapper pjb-objc-edit-close-square         paredit-close-square)
(pjb-objc-edit-define-wrapper pjb-objc-edit-open-curly           paredit-open-curly
  (backward-char 1)
  ;; (insert "\n")
  (c-indent-line-or-region)
  (forward-char 1)
  (insert "\n") (c-indent-line-or-region)
  (insert "\n") (c-indent-line-or-region)
  (previous-line) (c-indent-line-or-region))
(pjb-objc-edit-define-wrapper pjb-objc-edit-close-curly          paredit-close-curly
  (backward-char 1)
  (insert "\n") (c-indent-line-or-region)
  (forward-char 1)
  (insert "\n") (c-indent-line-or-region))
(pjb-objc-edit-define-wrapper pjb-objc-edit-close-curly          paredit-close-curly)
(pjb-objc-edit-define-wrapper pjb-objc-edit-wrap-sexp            paredit-wrap-sexp)
(pjb-objc-edit-define-wrapper pjb-objc-edit-wrap-square          paredit-wrap-square)
(pjb-objc-edit-define-wrapper pjb-objc-edit-wrap-curly           paredit-wrap-curly)
(pjb-objc-edit-define-wrapper pjb-objc-edit-backward-delete      paredit-backward-delete)
(pjb-objc-edit-define-wrapper pjb-objc-edit-backward-kill-word   paredit-backward-kill-word)


(defun pjb-objc-edit-meat ()
  (interactive)
  (loop
     for (command . keys)
     in '((pjb-ide-insert-tag-comment           "C-c p")
          (paredit-forward-slurp-sexp           "C-<right>"   "A-<right>"   "A-f" "C-)")
          (paredit-forward-barf-sexp            "C-<left>"    "A-<left>"    "A-g" "C-}")
          (paredit-backward-slurp-sexp          "C-M-<right>" "A-s-<right>" "A-d" "C-(")
          (paredit-backward-barf-sexp           "C-M-<left>"  "A-s-<left>"  "A-s" "C-{")
          (paredit-splice-sexp-killing-backward "M-<up>")
          (paredit-splice-sexp-killing-forward  "M-<down>")
          (paredit-splice-sexp                  "M-s")
          (pjb-objc-edit-doublequote            "\"")
          (pjb-objc-edit-backward-delete        "DEL")
          (pjb-objc-edit-backward-kill-word     "M-DEL")
          (pjb-objc-edit-open-round             "(")
          (pjb-objc-edit-close-round            ")")
          (pjb-objc-edit-open-square            "[")
          (pjb-objc-edit-close-square           "]") ; (pjb-objc-edit-electric-bracket-close "]")
          (pjb-objc-edit-open-curly             "{")
          (pjb-objc-edit-close-curly            "}")
          (pjb-objc-edit-close-curly            "}")
          (pjb-objc-edit-wrap-sexp              "M-(")
          (pjb-objc-edit-wrap-square            "M-[")
          (pjb-objc-edit-wrap-curly             "M-{")
          (pjb-objc-edit-forward-sexp           "C-c C-o C-f" "C-M-f")
          (pjb-objc-edit-backward-sexp          "C-c C-o C-b" "C-M-b")
          (pjb-objc-edit-convert-snail-to-camel "C-c C-o k")
          (pjb-objc-edit-convert-camel-to-snail "C-c C-o _")
          (pjb-objc-ide-find-superclass-file    "C-c C-o c")
          (pjb-objc-ide-beginning-of-class      "C-c C-o u")
          (pjb-objc-kill-ring-save-selector     "C-c C-o s")
          (sources-find-file-named              "C-c C-x C-f")
          (pjb-ide-insert-documentation-comment "C-c C-;"))
     do (loop for key in keys do (local-set-key (read-kbd-macro key) command)))
  ;; (auto-complete-mode 1)
  (global-set-key (kbd "C-c C-x C-f") 'sources-find-file-named)
  (pjb-objc-edit-add-font-lock-keywords))



(defun pjb-java-edit-meat ()
  (interactive)
  (loop
     for (command . keys)
     in '((pjb-ide-insert-tag-comment           "C-c p")
          (paredit-forward-slurp-sexp           "C-<right>"   "A-<right>"   "A-f" "C-)")
          (paredit-forward-barf-sexp            "C-<left>"    "A-<left>"    "A-g" "C-}")
          (paredit-backward-slurp-sexp          "C-M-<right>" "A-s-<right>" "A-d" "C-(")
          (paredit-backward-barf-sexp           "C-M-<left>"  "A-s-<left>"  "A-s" "C-{")
          (paredit-splice-sexp-killing-backward "M-<up>")
          (paredit-splice-sexp-killing-forward  "M-<down>")
          (paredit-splice-sexp                  "M-s")
          (pjb-objc-edit-doublequote            "\"")
          (pjb-objc-edit-backward-delete        "DEL")
          (pjb-objc-edit-backward-kill-word     "M-DEL")
          (pjb-objc-edit-open-round             "(")
          (pjb-objc-edit-close-round            ")")
          (pjb-objc-edit-open-square            "[")
          (pjb-objc-edit-close-square           "]") ; (pjb-objc-edit-electric-bracket-close "]")
          (pjb-objc-edit-open-curly             "{")
          (pjb-objc-edit-close-curly            "}")
          (pjb-objc-edit-close-curly            "}")
          (pjb-objc-edit-wrap-sexp              "M-(")
          (pjb-objc-edit-wrap-square            "M-[")
          (pjb-objc-edit-wrap-curly             "M-{")
          (pjb-objc-edit-forward-sexp           "C-c C-o C-f" "C-M-f")
          (pjb-objc-edit-backward-sexp          "C-c C-o C-b" "C-M-b")
          (pjb-objc-edit-convert-snail-to-camel "C-c C-o k")
          (pjb-objc-edit-convert-camel-to-snail "C-c C-o _")
          ;; (pjb-objc-ide-find-superclass-file    "C-c C-o c")
          ;; (pjb-objc-ide-beginning-of-class      "C-c C-o u")
          ;; (pjb-objc-kill-ring-save-selector     "C-c C-o s")
          (sources-find-file-named              "C-c C-x C-f"))
     do (loop for key in keys do (local-set-key (read-kbd-macro key) command)))
  (global-set-key (kbd "C-c C-x C-f") 'sources-find-file-named)
  (auto-complete-mode 1))


(global-set-key (kbd "C-c C-x C-f") 'sources-find-file-named)


(provide 'pjb-objc-edit)
;;;; THE END ;;;;
ViewGit