my favorite elisps

.gitignore

*.elc

fav.el


;;; ox-org - Export filtered headlines.
(require 'ox)

(org-export-define-backend
 'org
 '((headline . ox-org-headline))
 :options-alist
 '((:filter "ORG_FILTER" nil ox-org-filter t)))

(defvar ox-org-filter "ox-org-default-filter")

(defun ox-org-default-filter (headline)
  "Customize this or use #+OPTIONS: filter:ox-org-my-filter in Org file."
  t)

(defun ox-org-headline (headline contents info)
  (let ((f (plist-get info :filter)))
    (and (funcall (intern f) headline)
	 (let ((start (org-element-property :begin headline))
	       (end (org-element-property :end headline)))
	   (buffer-substring start end)))))

(defun ox-org-export-as-org
    (&optional async subtreep visible-only body-only ext-plist)
  (interactive)
  (org-export-to-buffer
   'org "*Org Org Export*"
   async subtreep visible-only body-only ext-plist))


;;; Save the word at point as if killed, but don't kill it.

(defun kill-ring-save-word-at-point ()
  "Save the word at point as if killed, but don't kill it."
  (interactive)
  (kill-new (thing-at-point 'word 'no-properties)))


;;; Patch for org-md.el.

;; Fix unexpected transcode in org-md-export-as-markdown.
(defun org-md-plain-list (plain-list contents info)
  "Transcode PLAIN-LIST element into Markdown format.
  CONTENTS is the plain-list contents.  INFO is a plist used as
  a communication channel."
  (if (eq 'item (org-element-type (org-export-get-parent-element plain-list)))
      contents
    (concat "\n" contents)))


;;; org-my-backend

(defun org-my-backward-heading-by-root-or (&optional fun)
  "Move up heading until reach the root or FUN returns nil."
  (if (when fun (funcall fun))
      (outline-previous-visible-heading 1)
    (while (and
	    (not (when fun (funcall fun)))
	    (/= 1 (org-current-level)))
      (outline-previous-visible-heading 1))))

(defun org-my-export-subtree ()
  "Run any org exporter and then export to any file.

Run any org exporter specified with org property `backend' and then
write export result to any file specified with `file'."
  (interactive)
  (save-window-excursion
    (save-excursion
      (save-restriction
	(org-my-backward-heading-by-root-or
	 (lambda ()
	   (org-entry-get (point) "backend")))
	(org-narrow-to-subtree)
	(let* ((file (org-entry-get (point) "file"))
	       (backend (intern (org-entry-get (point) "backend"))))
	  (org-export-to-file backend file))))))


;;; Do replace-regexp in current region.
(defun replace-area-regexp (regexp to-string &optional delimited start end)
  "Do replace-regexp in current region."
  (interactive
   (let ((common
	  (query-replace-read-args
	   (concat "Replace"
		   (if current-prefix-arg " word" "")
		   " regexp"
		   (if (and transient-mark-mode mark-active) " in region" ""))
	   t)))
     (list (nth 0 common) (nth 1 common) (nth 2 common)
	   (if (and transient-mark-mode mark-active)
	       (region-beginning))
	   (if (and transient-mark-mode mark-active)
	       (region-end)))))
  (save-window-excursion
    (save-excursion
      (save-restriction
	(narrow-to-region (mark-marker) (point))
	(goto-char (point-min))
	(perform-replace regexp to-string nil t delimited nil nil start end)))))


;;; Other favoriate functions.
(defun delete-file-kill-buffer ()
  ""
  (interactive)
  (let ((buf (current-buffer))
        (filepath (buffer-file-name (current-buffer))))
    (when (and
           (not (null filepath))
           (file-exists-p filepath))
      (delete-file filepath))
    (kill-buffer buf)))

(defun move-file (newname)
  ""
  (interactive "FRename file to: ")
  (let ((file (buffer-file-name (current-buffer))))
    (or file
	(error "Current buffer has no file."))
    (rename-file file newname t)
    (kill-buffer (current-buffer))
    (switch-to-buffer (find-file-noselect newname))))

(defun copy-line (arg)
  "Copy lines (as many as prefix argument) in the kill ring"
  (interactive "p")
  (kill-ring-save (line-beginning-position)
		  (line-beginning-position (+ 1 arg)))
  (message "%d line%s copied" arg (if (= 1 arg) "" "s")))

(defun kill-ring-save-line (&optional arg)
  "Save the rest of the current line to the kill-ring just like \\[kill-line]
without killing."
  (interactive "P")
  (save-excursion
    (kill-ring-save (point)
		  (progn
		    (if arg
			(forward-visible-line (prefix-numeric-value arg))
		      (if (eobp)
			  (signal 'end-of-buffer nil))
		      (let ((end
			     (save-excursion
			       (end-of-visible-line) (point))))
			(if (or (save-excursion
				  ;; If trailing whitespace is visible,
				  ;; don't treat it as nothing.
				  (unless show-trailing-whitespace
				    (skip-chars-forward " \t" end))
				  (= (point) end))
				(and kill-whole-line (bolp)))
			    (forward-visible-line 1)
			  (goto-char end)
			  )))
		    (point)))))

(provide 'fav)