Download
(require 'org-table)
(defun org-table-comment-p (&optional only-comment allow-blanks)
"Determines if you are in an either a org-table inside single comments or an org-table.
if ONLY-COMMENT is true only consider org-table inside single comments
IF ALLOW-BLANKS, a blank line is considered an org-table-comment"
(save-excursion
(goto-char (point-at-bol))
(let (ret)
(if (not (and (< 0 org-table-comment-permissive)
(not org-table-comment-permissive-text)))
(setq ret
(looking-at (concat (if allow-blanks "\\(?:^[ \t]*$\\|" "")
(if only-comment "" "\\(?:")
"[ \t]*" comment-start "+"
(if only-comment "" "\\)?")
(if org-table-comment-permissive-text
(regexp-quote org-table-comment-permissive-text)
"")
orgtbl-line-start-regexp
(if allow-blanks "\\)" ""))))
(setq ret (looking-at (concat (if allow-blanks "\\(?:^[ \t]*$\\|" "")
(if only-comment "" "\\(?:")
"[ \t]*" comment-start "+"
(if only-comment "" "\\)?")
(if org-table-comment-permissive "\\(.*?[ \t]*\\)" "")
orgtbl-line-start-regexp
(if allow-blanks "\\)" ""))))
(when ret
(setq org-table-comment-permissive-text (match-string-no-properties 1))
(if (< org-table-comment-permissive (length org-table-comment-permissive-text))
(progn
(setq ret nil)
(setq org-table-comment-permissive-text nil)
)
(if org-table-comment-permissive-text
(when (string-match "^[ \t]*$" org-table-comment-permissive-text)
(setq org-table-comment-permissive-text ""))
(setq org-table-comment-permissive-text "")))))
(symbol-value 'ret))))
(defun org-table-comment-region ()
"Gets the region for the comment orgtbl"
(when (org-table-comment-p)
(save-excursion
(let (start stop (pt (point)))
(forward-line -1)
(while (and (org-table-comment-p t t)
(not (= (point-min) (point-at-bol))))
(forward-line -1))
(unless (and (org-table-comment-p t) (= (point-min) (point-at-bol)))
(while (not (org-table-comment-p t))
(forward-line 1)))
(setq start (point-at-bol))
(goto-char pt)
(forward-line 1)
(while (and (org-table-comment-p t t)
(not (= (point-max) (point-at-eol))))
(forward-line 1))
(unless (and (org-table-comment-p t)
(= (point-max) (point-at-eol)))
(while (not (org-table-comment-p t))
(forward-line -1)))
(setq stop (+ 1 (point-at-eol)))
(list start stop)))))
(defun org-table-comment-narrow ()
"Narrow region to org-table comment"
(interactive)
(when (org-table-comment-p)
(let ((region (org-table-comment-region)))
(narrow-to-region (nth 0 region) (nth 1 region)))))
(defun org-table-comment-overlay ()
"Create overlay for org-table-comment"
(interactive)
(if (not (org-table-comment-p))
nil
(let ((region (org-table-comment-region))
over)
(setq over (make-overlay (nth 0 region) (nth 1 region) nil nil t))
(overlay-put over 'category 'org-table-comment-category)
(overlay-put over 'modification-hooks 'org-table-comment-mode)
over)))
(defun org-table-comment-overlay-rm (beg end)
"Remove org table comment overlays.
BEG is the beginning of the region to check
END is the end of the region to check"
(interactive (list (point-min) (point-max)))
(remove-overlays beg end 'org-comment-table t)
(setq org-table-comment-editing nil)
(setq org-table-comment-permissive-text nil))
(defun org-table-comment-overlay-get (pt)
"Gets the comment table overlay at point (if exists)."
(interactive (list (point)))
(let ((overlays (overlays-at pt))
found)
(while overlays
(let ((overlay (car overlays)))
(if (overlay-get overlay 'org-comment-table)
(progn
(setq found (nth 0 (cons overlay found)))
(setq overlays nil))))
(setq overlays (cdr overlays)))
found))
(defvar org-table-comment-before-edit-hook nil
"Hook for `org-table-comment-before-edit-hook'")
(defvar org-table-comment-after-edit-hook nil
"Hook for `org-table-comment-before-edit-hook'")
(defvar org-table-comment-category nil)
(unless org-table-comment-category
(put 'org-table-comment-category 'face 'highlight)
(put 'org-table-comment-category 'org-comment-table t))
(defun org-table-comment-edit (&optional pt)
"Starts editing an org-table in a comment"
(interactive)
(run-hooks 'org-table-comment-before-edit-hook)
(let (perm
(debug-on-error t) (debug-on-quit t))
(if (not org-table-comment-use-overlay)
(if (not (org-table-comment-p))
nil
(org-table-comment-narrow)
(uncomment-region (point-min) (point-max))
(setq perm org-table-comment-permissive-text)
(when (string= "" perm)
(setq perm nil))
(when perm
(when (string-match "^[ \t]*" perm)
(setq perm (replace-match "" nil nil perm)))
(save-excursion
(goto-char (point-min))
(while (re-search-forward (format "^[ \t]*%s" (regexp-quote perm)) nil t)
(replace-match ""))))
(setq org-table-comment-editing (point)))
(when (org-table-comment-p t)
(let ((over (org-table-comment-overlay-get (or pt (point)))))
(unless over
(setq over (org-table-comment-overlay)))
(when over
(uncomment-region (overlay-start over) (overlay-end over))
(setq perm org-table-comment-permissive-text)
(when (string= "" perm)
(setq perm nil))
(when perm
(when (string-match "^[ \t]*" perm)
(setq perm (replace-match "" nil nil perm)))
(save-excursion
(goto-char (overlay-start over))
(while (re-search-forward (format "^[ \t]*%s" (regexp-quote perm))
(overlay-end over) t)
(replace-match ""))))
(setq org-table-comment-editing (point))
over))))))
(defun org-table-comment-return (&optional passed-overlay)
"Stops editing an org-table in a comment"
(interactive)
(when org-table-comment-editing
(if (not org-table-comment-use-overlay)
(let ((perm org-table-comment-permissive-text))
(condition-case error
(comment-region (point-min) (point-max))
(error nil))
(when (string= "" perm)
(setq perm nil))
(when perm
(save-excursion
(goto-char (point-min))
(while (re-search-forward (format "^[ \t]*%s+" comment-start) nil t)
(when (looking-at "[ \t]*")
(replace-match perm)))))
(widen)
(run-hooks 'org-table-comment-after-edit-hook)
(setq org-table-comment-permissive-text nil)
(setq org-table-comment-editing nil))
(let ((over (or passed-overlay (org-table-comment-overlay-get org-table-comment-editing)))
(perm org-table-comment-permissive-text))
(when over
(condition-case error
(comment-region (overlay-start over) (overlay-end over))
(error nil))
(when (string= "" perm)
(setq perm nil))
(when perm
(save-excursion
(goto-char (overlay-start over))
(while (re-search-forward (format "^[ \t]*%s+" comment-start) (overlay-end over) t)
(when (looking-at "[ \t]*")
(replace-match org-table-comment-permissive-text)))))
(delete-overlay over)
(setq org-table-comment-permissive-text nil)
(setq org-table-comment-editing nil)
(run-hooks 'org-table-comment-after-edit-hook))))))
(defgroup org-table-comment nil
"Options for using org-table when in single comment areas."
:group 'org-table)
(defcustom org-table-comment-use-overlay t
"User overlays instead of narrowing to a region when editing region."
:group 'org-table-comment
:type 'boolean)
(defvar org-table-comment-permissive-text nil
"Variable storing what the permissive text is when `org-table-comment-permissive' is true.")
(defcustom org-table-comment-permissive 4
"The org-mode comment is permissive. Therefore as long as it
starts with `comment-start' and some combination of characters at
a maximum length of `org-table-comment-permissive', followed by
an org-table, it will be considered an org-comment-table. For
example:
;; % #+ORGTBL: SEND salesfigures orgtbl-to-latex
;; % |-------+------+---------+---------|
;; % | Month | Days | Nr sold | per day |
;; % |-------+------+---------+---------|
;; % | Jan | 23 | 55 | 2.4 |
;; % | Feb | 21 | 16 | 0.8 |
;; % | March | 22 | 278 | 12.6 |
;; % |-------+------+---------+---------|
;; % #+TBLFM: $4=$3/$2;.1f
can be edited in elisp mode. In this example ' %' is stored as the `org-table-comment-permissive-text'
Zero or below is considered a non-permissive comment
"
:type 'integer
:group 'org-table-comment)
(defvar org-table-comment-editing nil
"Variable to describe if we are editing a commented org-table")
(defvar org-table-comment-at-beginning nil)
(defvar org-table-comment-at-end nil)
(defun org-table-comment-pre-command ()
"Pre-command called for `orgtbl-comment-mode'"
(condition-case error
(progn
(unless (memq 'org-table-comment-post-command post-command-hook)
(add-hook 'post-command-hook 'org-table-comment-post-command))
(when (and orgtbl-comment-mode (not (minibufferp)))
(setq org-table-comment-at-beginning (= (point-at-bol) (point-min)))
(setq org-table-comment-at-end (= (point-at-eol) (point-max)))))
(error
(message "[org-table-comment] Error running pre-command-hook: %s" (error-message-string error)))))
(defun org-table-comment-post-command ()
"Post-command called for `org-table-comment'"
(condition-case error
(progn
(unless (memq 'org-table-comment-pre-command pre-command-hook)
(add-hook 'pre-command-hook 'org-table-comment-pre-command))
(when (and orgtbl-comment-mode orgtbl-mode (not (minibufferp)))
(let ((over (if org-table-comment-use-overlay (org-table-comment-overlay-get (point)) nil)))
(cond
((and org-table-comment-use-overlay (not org-table-comment-editing)
(org-table-comment-p t))
(org-table-comment-edit))
((and over (string-match "\\`[ \t\n]*\\'" (buffer-substring-no-properties (overlay-start over) (overlay-end over))))
(setq org-table-comment-editing nil)
(setq org-table-comment-permissive-text nil)
(delete-overlay over))
((and org-table-comment-use-overlay over org-table-comment-editing)
(setq org-table-comment-editing (point)))
((and org-table-comment-use-overlay org-table-comment-editing (not over))
(org-table-comment-return))
((and (not org-table-comment-use-overlay) org-table-comment-editing
org-table-comment-at-end
(memq this-command '(next-line)))
(org-table-comment-return)
(next-line))
((and (not org-table-comment-use-overlay) org-table-comment-editing
org-table-comment-at-beginning
(memq this-command '(previous-line)))
(org-table-comment-return)
(previous-line))
((and (not org-table-comment-use-overlay)
org-table-comment-editing
(memq this-command '(cua-scroll-down cua-scroll-up scroll-up scroll-down)))
(org-table-comment-return))
((and (not org-table-comment-use-overlay)
(not org-table-comment-editing) (org-table-comment-p))
(org-table-comment-edit))))))
(error
(message "[org-table-comment] Error running post-command-hook: %s" (error-message-string error)))))
(defalias 'org-table-comment-mode 'orgtbl-comment-mode)
(define-minor-mode orgtbl-comment-mode
"Orgtbl comment mode. Changes how orgtbl works for modes that don't support block comment regions (like emacs-lisp).
Currently supports radio tables through overlay interface.
"
nil
""
:group 'org-table-comment
(let (
(orgtbl (assoc 'orgtbl-mode minor-mode-alist)))
(when orgtbl
(setq orgtbl (cdr orgtbl))
(if orgtbl-comment-mode
(setcar orgtbl (replace-regexp-in-string "[*]*$" "*" (car orgtbl)))
(setcar orgtbl (replace-regexp-in-string "[*]+$" "" (car orgtbl))))))
(cond (orgtbl-comment-mode
(orgtbl-mode 1)
(set (make-local-variable 'org-table-comment-editing) nil)
(set (make-local-variable 'org-table-comment-permissive-text) nil)
(set (make-local-variable 'org-table-comment-at-beginning) nil)
(set (make-local-variable 'org-table-comment-at-end) nil)
(set (make-local-variable 'org-table-comment-pre-point) nil)
(add-hook 'write-contents-hooks 'org-table-comment-return nil t)
(add-hook 'post-command-hook 'org-table-comment-pre-command nil t)
(add-hook 'pre-command-hook 'org-table-comment-post-command nil t))
(t
(orgtbl-mode -1)
(set (make-local-variable 'org-table-comment-editing) nil)
(set (make-local-variable 'org-table-comment-at-beginning) nil)
(set (make-local-variable 'org-table-comment-at-end) nil)
(set (make-local-variable 'org-table-comment-pre-point) nil)
(remove-hook 'post-command-hook 'org-table-comment-pre-command t)
(remove-hook 'pre-command-hook 'org-table-comment-post-command t)
(remove-hook 'write-contents-hook 'org-table-comment-return t))))
(provide 'org-table-comment)