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

267 lines
8.1 KiB
EmacsLisp
Raw Permalink Normal View History

2014-08-21 00:23:56 +02:00
;;; 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