2016-04-06 19:56:16 +00:00
|
|
|
;;; fmt.el --- .org file formatter.
|
|
|
|
;;
|
|
|
|
;; Copyright (c) 2012-2016 Sylvain Benner & Contributors
|
|
|
|
;;
|
|
|
|
;; Author: Sylvain Benner <sylvain.benner@gmail.com>
|
|
|
|
;; URL: https://github.com/syl20bnr/spacemacs
|
|
|
|
;;
|
|
|
|
;; This file is not part of GNU Emacs.
|
|
|
|
;;
|
|
|
|
;;; License: GPLv3
|
|
|
|
|
|
|
|
|
2016-05-27 02:30:56 +00:00
|
|
|
(load-file "./core/tools/spacefmt/toc-org.el")
|
2016-04-06 19:56:16 +00:00
|
|
|
|
|
|
|
(require 'cl)
|
|
|
|
(require 'files)
|
|
|
|
(require 'org)
|
2016-05-27 02:18:44 +00:00
|
|
|
(require 'thingatpt)
|
2016-04-06 19:56:16 +00:00
|
|
|
|
|
|
|
(defconst empty-line-regexp "^[ \t]*$")
|
|
|
|
|
|
|
|
(defconst toc-heading-head "* Table of Contents")
|
|
|
|
(defconst toc-heading-tail ":TOC_4_gh:noexport:")
|
|
|
|
(defconst toc-headline (format "%-41s%s"
|
|
|
|
toc-heading-head
|
|
|
|
toc-heading-tail))
|
|
|
|
|
|
|
|
(defun apply-all ()
|
|
|
|
"Apply all filters."
|
|
|
|
(remove-empty-lines-at-the-beginning)
|
|
|
|
(insert-title)
|
|
|
|
(insert-toc)
|
|
|
|
(apply-toc)
|
|
|
|
(remove-empty-lines-after-headlines)
|
|
|
|
;; Multiply empty lines are handled by
|
|
|
|
;; the bash script.
|
|
|
|
(insert-empty-line-before-tables)
|
|
|
|
(insert-empty-line-after-tables)
|
|
|
|
(insert-empty-line-after-sections)
|
|
|
|
(insert-empty-line-at-the-end)
|
|
|
|
(align-tables)
|
|
|
|
(save-buffer 0))
|
|
|
|
|
|
|
|
(defun remove-empty-lines-at-the-beginning ()
|
|
|
|
"Remove empty lines at the begging of the buffer."
|
|
|
|
(goto-char (point-min))
|
|
|
|
(while (looking-at-p empty-line-regexp)
|
|
|
|
(delete-blank-lines)))
|
|
|
|
|
|
|
|
(defun insert-empty-line-at-the-end ()
|
|
|
|
"Insert an empty line at the end of the buffer."
|
|
|
|
(goto-char (point-max))
|
|
|
|
(unless (looking-at-p empty-line-regexp)
|
|
|
|
(open-line 1)))
|
|
|
|
|
|
|
|
(defun insert-title()
|
|
|
|
"Insert #TITLE:{DIR_NAME} if the buffer doesn't have one."
|
|
|
|
(goto-char (point-min))
|
|
|
|
(unless (looking-at-p "^#\\+TITLE:.*$")
|
|
|
|
(insert (format "#+TITLE:%s\n"
|
|
|
|
(clj/->> (buffer-file-name)
|
|
|
|
file-name-directory
|
|
|
|
directory-file-name
|
|
|
|
file-name-base)))))
|
|
|
|
|
|
|
|
(defun insert-toc ()
|
|
|
|
"Insert toc if the buffer doesn't have one."
|
|
|
|
(goto-char (point-min))
|
|
|
|
(unless (re-search-forward toc-org-toc-org-regexp nil t)
|
|
|
|
(goto-char (point-max))
|
|
|
|
;; Skip from the end of the buffer to the first headling.
|
|
|
|
(while (re-search-backward org-heading-regexp nil t))
|
|
|
|
(open-line 3)
|
|
|
|
(forward-line 1)
|
2016-11-07 10:36:26 +00:00
|
|
|
(insert toc-headline)))
|
2016-04-06 19:56:16 +00:00
|
|
|
|
|
|
|
(defun remove-empty-lines-after-headlines()
|
|
|
|
"Remove empty liners after each headline."
|
|
|
|
(goto-char (point-min))
|
|
|
|
(while (re-search-forward org-heading-regexp nil t)
|
|
|
|
(unless (= (forward-line) 0)
|
|
|
|
(while (looking-at-p empty-line-regexp)
|
|
|
|
(delete-blank-lines)))))
|
|
|
|
|
|
|
|
(defun insert-empty-line-before-tables ()
|
|
|
|
"Insert an empty line before each org table."
|
|
|
|
(goto-char (point-min))
|
|
|
|
(while (goto-next-table)
|
|
|
|
(forward-line -1)
|
|
|
|
(unless (looking-at-p empty-line-regexp)
|
|
|
|
(end-of-line)
|
|
|
|
(open-line 1))
|
|
|
|
(forward-line 1)))
|
|
|
|
|
|
|
|
(defun insert-empty-line-after-sections ()
|
|
|
|
"Insert an empty line after each section."
|
|
|
|
(goto-char (point-min))
|
|
|
|
(while (re-search-forward org-heading-regexp nil t)
|
|
|
|
(forward-line -1)
|
|
|
|
(unless (or (looking-at-p empty-line-regexp)
|
|
|
|
(looking-at-p org-heading-regexp))
|
|
|
|
(end-of-line)
|
|
|
|
(open-line 1))
|
|
|
|
(forward-line 2)))
|
|
|
|
|
|
|
|
(defun insert-empty-line-after-tables ()
|
|
|
|
"Insert an empty line after each table."
|
|
|
|
(goto-char (point-min))
|
|
|
|
(while (goto-next-table)
|
|
|
|
;; Skip current table.
|
|
|
|
(while (looking-at-p org-table-any-line-regexp)
|
|
|
|
(forward-line))
|
|
|
|
(unless (looking-at-p empty-line-regexp)
|
|
|
|
(beginning-of-line)
|
|
|
|
(open-line 1)
|
|
|
|
(forward-line))))
|
|
|
|
|
|
|
|
(defun align-tables ()
|
|
|
|
"Align all tables"
|
|
|
|
(goto-char (point-min))
|
|
|
|
(while (goto-next-table)
|
|
|
|
(org-table-align)))
|
|
|
|
|
|
|
|
(defun apply-toc ()
|
|
|
|
"Apply current toc-org TAG to TOC."
|
|
|
|
(goto-char (point-min))
|
|
|
|
(toc-org-insert-toc))
|
|
|
|
|
|
|
|
(defun goto-next-table ()
|
|
|
|
"Goto next org table.
|
|
|
|
Returns nil if no more tables left."
|
|
|
|
;; Skip current table.
|
|
|
|
(while (looking-at-p org-table-any-line-regexp)
|
|
|
|
(forward-line))
|
|
|
|
;; Skip to the next table.
|
|
|
|
(when (re-search-forward org-table-hline-regexp nil t)
|
|
|
|
(forward-line -1 )))
|
|
|
|
|
2016-05-27 02:18:44 +00:00
|
|
|
(defun move-packages-to-config ()
|
|
|
|
"Move xxx-packages list to config.el."
|
|
|
|
(let ((config-file (concat default-directory "config.el")))
|
|
|
|
(when (or (re-search-forward "(setq.*-packages" nil t)
|
|
|
|
(re-search-forward "(defcustom.*-packages" nil t))
|
|
|
|
(re-search-backward "(")
|
|
|
|
(kill-sexp)
|
|
|
|
(with-current-buffer (find-file-noselect config-file)
|
|
|
|
(when (file-exists-p config-file)
|
|
|
|
(re-search-forward ";;; License: GPLv3")
|
|
|
|
(newline)
|
|
|
|
(forward-line 2))
|
|
|
|
(yank)
|
|
|
|
;; config.el
|
|
|
|
(save-buffer 0))
|
|
|
|
;; packages.el
|
|
|
|
(save-buffer 0))))
|
|
|
|
|
2016-04-06 19:56:16 +00:00
|
|
|
(defmacro clj/->> (o &rest forms)
|
|
|
|
"Threads the expr through the forms.
|
2016-05-27 02:18:44 +00:00
|
|
|
Inserts o as the last item in the first form,
|
|
|
|
making a list of it if it is not a list already.
|
2016-04-06 19:56:16 +00:00
|
|
|
If there are more forms, inserts the first form
|
2016-05-27 02:18:44 +00:00
|
|
|
as the last item in second form, etc."
|
2016-04-06 19:56:16 +00:00
|
|
|
(cond ((not forms) o)
|
|
|
|
((= 1 (length forms))
|
|
|
|
(let ((f (first forms)))
|
|
|
|
(append (if (symbolp f)
|
|
|
|
(list f) f)
|
|
|
|
(list o))))
|
|
|
|
(:else `(clj/->> (clj/->> ,o ,(first forms)) ,@(rest forms)))))
|