postgresql-funcedit.el

(defconst pgef-subedit-message
  "Type 'C-c C-c' once done, or 'C-c C-k' to abort edit"
  "Message to post in the minibuffer when an edit buffer is displayed.")


(defvar pgef-subedit-mode-map
  ;; Use (make-keymap) because (make-sparse-keymap) does not work on Demacs.
  (let ((pgef-subedit-mode-map (make-keymap)))
    (define-key pgef-subedit-mode-map "\C-c\C-c" 'pgef-subedit-exit)
    (define-key pgef-subedit-mode-map "\C-c\C-k" 'pgef-subedit-abort)
    (define-key pgef-subedit-mode-map "\C-c@" 'pgef-subedit-exit)
    (define-key pgef-subedit-mode-map "\C-c!" 'pgef-subedit-abort)
    pgef-subedit-mode-map)
  "Keymap while editing a function body.")


;; see http://wiki.postgresql.org/wiki/PL_Matrix
(defvar pgef-modes-alist
  '(("sql" . sql-mode)
    ("plpgsql" . sql-mode)
    ("plperl" . perl-mode)
    ("plperlu" . perl-mode)
    ("plpythonu" . python-mode)
    ("plpython2u" . python-mode)
    ("plpython3u" . python-mode)
    ("pltcl" . tcl-mode)
    ("pltclu" . tcl-mode)
    ("plsh" . normal-mode)              ;; figure out by #! line
    ("plr" . FIXME)
    ("java" . java-mode)
    ("plscheme" . scheme-mode)
    ("plphp" . php-mode)
    ("plruby" . ruby-mode)
    ("pllua" . lua-mode)
    ("plv8" . js-mode))
  "Associates PostgreSQL procedural language names with Emacs major modes.
See <http://wiki.postgresql.org/wiki/PL_Matrix>.")


;; these are made buffer local
(defvar pgef-start-of-body)
(defvar pgef-end-of-body)
(defvar pgef-func-name)
(defvar pgef-language)
(defvar pgef-subedit-back-pointer)
(defvar pgef-subbuffers nil)
(defvar pgef-init-done nil)


(defun pgef-set-body (string)
  "Insert STRING between previously located boundaries of function body."
  (goto-char pgef-start-of-body)
  (delete-region pgef-start-of-body pgef-end-of-body)
  (insert string))


(defun pgef-redisplay ()
  "Redisplay the current function."
  (goto-char pgef-start-of-body))


(defun pgef-kill-buffer-query-function ()
  "Hook function"
  (if pgef-subbuffers
      (yes-or-no-p "Function edit buffers exist.  Really kill the SQL buffer? ")))


(defun pgef-init-once ()
  "Do various initializations, but only once."
  (if (not pgef-init-done)
      (progn
        (make-local-variable 'pgef-start-of-body)
        (make-local-variable 'pgef-end-of-body)
        (set (make-local-variable 'pgef-func-name) nil)
        (set (make-local-variable 'pgef-language) nil)
        (set (make-local-variable 'pgef-subedit-back-pointer) nil)
        (set (make-local-variable 'pgef-subbuffers) nil)
        (add-hook 'kill-buffer-query-functions ' pgef-kill-buffer-query-function)
        (set (make-local-variable 'pgef-init-done) t))))


(defun pgef-subedit-abort ()
  "Exit the subedit buffer, merely discarding its contents."
  (interactive)
  (let* ((edit-buffer (current-buffer))
         (back-pointer pgef-subedit-back-pointer)
         (entry-marker (nth 0 back-pointer))
         (overlay-info (nth 2 back-pointer))
         (entry-buffer (marker-buffer entry-marker)))
    (if (null entry-buffer)
        (error "Corresponding SQL buffer does not exist anymore")
      (or (one-window-p) (delete-window))
      (switch-to-buffer entry-buffer)
      (goto-char entry-marker)
      (and overlay-info (pgef-dehighlight overlay-info))
      (or (kill-buffer edit-buffer) (message "Edit buffer not killed successfully.")) ; FIXME
      (setq pgef-subbuffers (delete back-pointer pgef-subbuffers)))))


(defun pgef-subedit-exit ()
  "Exit the subedit buffer, replacing the string in the SQL buffer."
  (interactive)
  (set-buffer-modified-p nil)
  (run-hooks 'pgef-subedit-exit-hook)
  (let ((string (buffer-string)))
    (pgef-subedit-abort)
    (condition-case nil
        (pgef-find-span-of-entry)
      (search-failed (message "Did not find a function definition around the point (Did you delete it?)")))
    (pgef-set-body string)
    (pgef-redisplay)))


;; stolen from po-edit-string
(defun pgef-edit-string (string plang)
  "Prepare a pop up buffer for editing STRING, which is of a given PLANG.
Run functions on pgef-subedit-mode-hook."
  (pgef-init-once)
  (let ((marker (make-marker)))
    (set-marker marker pgef-start-of-body)
    (if t ; FIXME (po-check-for-pending-edit marker)
        (let ((edit-buffer (generate-new-buffer
                            (concat "*" pgef-func-name "*")))
              (edit-coding buffer-file-coding-system)
              (buffer (current-buffer))
              overlay slot)
          (setq overlay (pgef-create-overlay))
          (pgef-highlight overlay pgef-start-of-body pgef-end-of-body buffer)
          (setq slot (list marker edit-buffer overlay)
                pgef-subbuffers (cons slot pgef-subbuffers))
          (pop-to-buffer edit-buffer)
          ;(set-visited-file-name "somefuncname" t t) ;; XXX for python flymake
          (setq buffer-file-name "somefuncname") ;; FIXME for python flymake
          (setq buffer-file-coding-system edit-coding)
          (erase-buffer)
          (insert string)
          (condition-case err
              (funcall (or (assoc-default plang pgef-modes-alist)
                           'fundamental-mode))
            ((debug error) (message "Error while setting major mode: %s" (error-message-string err))))
          (set (make-local-variable 'pgef-subedit-back-pointer) slot)
          (goto-char (point-min))
          (set-buffer-modified-p nil)
          (use-local-map pgef-subedit-mode-map)
          (run-hooks 'po-subedit-enter-hook)
          (message pgef-subedit-message)))))


;; stolen from dim:pgsql-current-func
(defun pgef-find-span-of-entry ()
  "Set variables pgef-start-of-body, pgef-end-of-body."
  (save-excursion
    (let* ((start (point))
           (prev-create-function
            (re-search-backward "create.*function +\\([a-z0-9_]+ *([^)]*)\\)"))
           (func-name
            (match-string-no-properties 1))
           (open-as-$$
            (when prev-create-function
              ;; limit the search to next semi-colon
              (let ((next-semi-col (re-search-forward ";" nil t)))
                (goto-char prev-create-function)
                (re-search-forward "AS[^$]*\\$\\([^$\n]*\\)\\$" next-semi-col))))
           ($$-name
            (when open-as-$$ (match-string-no-properties 1)))
           (close-as-$$
            (when open-as-$$
              (re-search-forward (format "\\$%s\\$" $$-name))
              (match-beginning 0)))
           (language-before-body
            (when prev-create-function
              (goto-char prev-create-function)
              (re-search-forward "language +\\([a-z]+\\)" open-as-$$ t)
              (match-string-no-properties 1)))
           (language-after-body
            (when close-as-$$
              (goto-char close-as-$$)
              (let ((next-semi-col (re-search-forward ";" nil t)))
                (goto-char close-as-$$)
                (re-search-forward "language +\\([a-z0-9]+\\)" next-semi-col t)
                (match-string-no-properties 1)))))
      ;; heuristic: don't allow searching backwards too far
      (if (< (- start close-as-$$) 50)
          (progn
            (setq pgef-start-of-body open-as-$$)
            (setq pgef-end-of-body close-as-$$)
            (setq pgef-func-name func-name)
            (setq pgef-language (or language-before-body language-after-body)))
        (signal 'search-failed nil)))))


(defun pgef-get-func-body ()
  "Return the function body of the function at point."
  (buffer-substring pgef-start-of-body pgef-end-of-body))


(defun pgef-edit-func ()
  "Use another window to edit the current function body."
  (interactive)
  (condition-case nil
      (progn
        (pgef-find-span-of-entry)
        (pgef-edit-string (pgef-get-func-body) pgef-language))
    (search-failed (message "Did not find a function definition around the point"))))


;;; highlighting support

(defun pgef-create-overlay ()
  (let ((overlay (make-overlay (point) (point))))
    (overlay-put overlay 'face 'highlight)
    (delete-overlay overlay)
    overlay))

(defun pgef-highlight (overlay start end &optional buffer)
  (move-overlay overlay start end (or buffer (current-buffer))))

(defun pgef-dehighlight (overlay)
  (delete-overlay overlay))


;;; initialization

(defun pgef-sql-hookfunc ()
  "A hook function that binds C-c ' to pgef-edit-func."
  (local-set-key (kbd "C-c '") 'pgef-edit-func))

(defun pgef-install ()
  "Install pgef into sql-mode."
  (interactive)
  (require 'sql)
  (add-hook 'sql-mode-hook 'pgef-sql-hookfunc))

(pgef-install)

(provide 'pgef)