legacy-dotfiles/emacs/site-lisp/eltuki.el

;;; eltuki.el --- Tekuti functions

;; Copyright (C) 2012  Tom Willemse

;; Author: Tom Willemse <slash@drd>
;; Keywords: convenience

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU 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 General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Tekuti functions.

;;; Code:

(require 'org)

(defgroup eltuki
  nil
  "tekuti functions in Emacs."
  :group 'external)

(defcustom eltuki-blog-dir "~/blog"
  "Plain blog post directory, not the git repository."
  :group 'eltuki
  :type 'string)

(defcustom eltuki-default-status "publish"
  "Default status to use when status is unknown."
  :group 'eltuki
  :type 'string)

(defcustom eltuki-default-comment-status "open"
  "Default status for comments."
  :group 'eltuki
  :type 'string)

(define-skeleton eltuki-post
  "Create a post template for eltuki."
  ""
  "#+TITLE: " (skeleton-read "Title: ") "\n"
  "#+TIMESTAMP: \n"
  "#+TAGS: " (skeleton-read "Tags (comma separated): ") "\n"
  "\n"
  _)

(defun eltuki-new-post ()
  (interactive)
  (switch-to-buffer (get-buffer-create "*eltuki*"))
  (org-mode)
  (eltuki-post))

(defun eltuki-get-title ()
  (save-excursion
    (goto-char (point-min))
    (if (re-search-forward "^#\\+TITLE: \\(.*\\)$" nil t)
        (buffer-substring-no-properties
         (match-beginning 1) (match-end 1))
      (error "Post has no title."))))

(defun eltuki-set-title (title)
  (interactive "MTitle: ")
  (setq title (concat " " title))
  (save-excursion
    (goto-char (point-min))
    (if (re-search-forward "^#\\+TITLE:\\(.*\\)$" nil t)
        (replace-match title t t nil 1)
      (insert "#+TITLE:" title "\n")
      (unless (= (char-after) ?\n)
        (insert-char ?\n)))))

(defun eltuki-get-timestamp ()
  (save-excursion
    (goto-char (point-min))
    (if (re-search-forward "^#\\+TIMESTAMP: \\([[:digit:]]+\\)$" nil t)
        (match-string 1)
      (format-time-string "%s"))))

(defun eltuki-set-timestamp ()
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (let ((newtime (format-time-string " %s")))
      (if (re-search-forward "^#\\+TIMESTAMP:\\(.*\\)$" nil t)
          (replace-match newtime nil t nil 1)
        (when (search-forward "\n\n" nil t)
          (backward-char))
        (insert "#+TIMESTAMP:" newtime "\n")))))

(defun eltuki-get-tags ()
  (save-excursion
    (goto-char (point-min))
    (when (re-search-forward "^#\\+TAGS: \\(.*\\)$" nil t)
      (buffer-substring-no-properties
       (match-beginning 1) (match-end 1)))))

(defun eltuki-set-tags (tags)
  (interactive "MTags: ")
  (setq tags (concat " " tags))
  (save-excursion
    (goto-char (point-min))
    (if (re-search-forward "^#\\+TAGS:\\(.*\\)$" nil t)
        (replace-match tags t t nil 1)
      (when (search-forward "\n\n" nil t)
        (backward-char))
      (insert "#+TAGS:" tags "\n"))))

(defun eltuki-get-status ()
  (save-excursion
    (goto-char (point-min))
    (if (re-search-forward "^#\\+STATUS: \\(draft\\|publish\\)$" nil t)
        (buffer-substring-no-properties
         (match-beginning 1) (match-end 1))
      eltuki-default-status)))

(defun eltuki-toggle-status ()
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (let ((newstatus (if (string= (eltuki-get-status) "draft")
                         " publish"
                       " draft")))
      (if (re-search-forward "^#\\+STATUS:\\(.*\\)$" nil t)
          (replace-match newstatus t t nil 1)
        (when (search-forward "\n\n" nil t)
          (backward-char))
        (insert "#+STATUS:" newstatus "\n")))))

(defun eltuki-get-comment-status ()
  (save-excursion
    (goto-char (point-min))
    (if (re-search-forward
         "^#\\+COMMENTSTATUS: \\(open\\|closed\\)$" nil t)
        (buffer-substring-no-properties
         (match-beginning 1) (match-end 1))
      eltuki-default-comment-status)))

(defun eltuki-toggle-comment-status ()
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (let ((newstatus (if (string= (eltuki-get-comment-status) "closed")
                         " open"
                       " closed")))
      (if (re-search-forward "^#\\+COMMENTSTATUS:\\(.*\\)$" nil t)
          (replace-match newstatus t t nil 1)
        (when (search-forward "\n\n" nil t)
          (backward-char))
        (insert "#+COMMENTSTATUS:" newstatus "\n")))))

(defun eltuki-slugify-string (str)
  (while (string-match "[^a-zA-Z0-9 ]+" str)
    (setq str (replace-match "" nil t str)))
  (while (string-match " +" str)
    (setq str (replace-match "-" nil t str)))
  (downcase str))

(defun eltuki-get-directory ()
  (concat
   eltuki-blog-dir "/"
   (format-time-string "%Y%%2f%m%%2f%d%%2f")
   (eltuki-slugify-string (eltuki-get-title))))

(defun eltuki-write-content (dir)
  (let ((org-export-with-toc nil)
        (org-export-with-section-numbers nil)
        (filename (concat dir "/content"))
        (org-export-show-temporary-export-buffer nil))
    (org-html-export-as-html nil nil nil t)
    (with-current-buffer "*Org HTML Export*"
      (write-region (point-min) (point-max) filename)
      (kill-buffer))
    filename))

(defun eltuki-write-metadata (dir)
  (let ((timestamp (eltuki-get-timestamp))
        (tags (eltuki-get-tags))
        (status (eltuki-get-status))
        (title (eltuki-get-title))
        (name (eltuki-slugify-string (eltuki-get-title)))
        (commentstatus (eltuki-get-comment-status))
        (filename (concat dir "/metadata")))
  (with-temp-buffer
    (insert "timestamp: " timestamp "\n"
            "tags: " tags "\n"
            "status: " status "\n"
            "title: " title "\n"
            "name: " name "\n"
            "comment_status: " commentstatus)
    (write-region (point-min) (point-max) filename))
  filename))

(defun eltuki-save-org (buffer dir)
  (let ((filename (concat dir "/post.org")))
    (with-current-buffer buffer
      (write-file filename))
    filename))

(defun eltuki-git-add (file)
  (shell-command (concat "cd " eltuki-blog-dir "; git add '" (expand-file-name file) "'")))

(defun eltuki-commit ()
  (shell-command (concat "cd " eltuki-blog-dir "; git commit -m \"new post: \\\"" (eltuki-get-title)
                         "\\\"\"")))

(defun eltuki-finish ()
  (interactive)
  (let ((buffer (or (get-buffer "*eltuki*")
                    (current-buffer)))
        (dest (eltuki-get-directory)))
    (unless (file-exists-p dest)
      (mkdir dest))

    (mapc #'eltuki-git-add
          (list (eltuki-write-content dest)
                (eltuki-write-metadata dest)
                (eltuki-save-org buffer dest)))

    (eltuki-commit)
    (kill-buffer buffer)))

(defun eltuki-process-sentinel (proc status)
  "Print PROC's STATUS."
  (message "git %s" (substring status 0 -1)))

(defun eltuki--passwd-prompt (string)
  "Decide on what to prompt based on STRING."
  (cond
   ((or
     (string-match "^Enter passphrase for key '\\\(.*\\\)': $" string)
     (string-match "^\\\(.*\\\)'s password:" string))
    (format "Password for '%s': " (match-string 1 string)))
   ((string-match "^[pP]assword:" string)
    "Password:")))

(defun eltuki-process-filter (proc string)
  "Check if PROC is asking for a password in STRING."
  (with-current-buffer (process-buffer proc)
    (let ((inhibit-read-only t)
          (ask (eltuki--passwd-prompt string)))
      (if ask
          (process-send-string proc (concat (read-passwd ask nil) "\n"))
        (insert string)))))

(defun eltuki-publish ()
  "Publish posts."
  (interactive)
  (let* ((default-directory (concat eltuki-blog-dir "/"))
         (proc (start-process "eltuki-publish" "*eltuki-publish*"
                              "git" "push")))
    (set-process-sentinel proc 'eltuki-process-sentinel)
    (set-process-filter proc 'eltuki-process-filter)))

(provide 'eltuki)
;;; eltuki.el ends here