summaryrefslogtreecommitdiff
path: root/custom
diff options
context:
space:
mode:
authorCraig Jennings <c@cjennings.net>2024-04-07 13:41:34 -0500
committerCraig Jennings <c@cjennings.net>2024-04-07 13:41:34 -0500
commit754bbf7a25a8dda49b5d08ef0d0443bbf5af0e36 (patch)
treef1190704f78f04a2b0b4c977d20fe96a828377f1 /custom
new repository
Diffstat (limited to 'custom')
-rw-r--r--custom/c-boxes.el407
-rw-r--r--custom/edit-indirect.el440
-rw-r--r--custom/elpa-mirror.el450
-rw-r--r--custom/faith.el566
-rw-r--r--custom/profile-dotemacs.el200
-rw-r--r--custom/sdcv-mode.el414
6 files changed, 2477 insertions, 0 deletions
diff --git a/custom/c-boxes.el b/custom/c-boxes.el
new file mode 100644
index 00000000..273b783a
--- /dev/null
+++ b/custom/c-boxes.el
@@ -0,0 +1,407 @@
+;;; Boxed comments for C mode.
+;;; Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
+;;; Francois Pinard <pinard@iro.umontreal.ca>, April 1991.
+;;;
+;;; I often refill paragraphs inside C comments, while stretching or
+;;; shrinking the surrounding box as needed. This is a real pain to
+;;; do by hand. Here is the code I made to ease my life on this,
+;;; usable from within GNU Emacs. It would not be fair giving all
+;;; sources for a product without also giving the means for nicely
+;;; modifying them.
+;;;
+;;; The function rebox-c-comment adjust comment boxes without
+;;; refilling comment paragraphs, while reindent-c-comment adjust
+;;; comment boxes after refilling. Numeric prefixes are used to add,
+;;; remove, or change the style of the box surrounding the comment.
+;;; Since refilling paragraphs in C mode does make sense only for
+;;; comments, this code redefines the M-q command in C mode. I use
+;;; this hack by putting, in my .emacs file:
+;;;
+;;; (setq c-mode-hook
+;;; '(lambda ()
+;;; (define-key c-mode-map "\M-q" 'reindent-c-comment)))
+;;; (autoload 'rebox-c-comment "c-boxes" nil t)
+;;; (autoload 'reindent-c-comment "c-boxes" nil t)
+;;;
+;;; The cursor should be within a comment before any of these
+;;; commands, or else it should be between two comments, in which case
+;;; the command applies to the next comment. When the command is
+;;; given without prefix, the current comment box type is recognized
+;;; and preserved. Given 0 as a prefix, the comment box disappears
+;;; and the comment stays between a single opening `/*' and a single
+;;; closing `*/'. Given 1 or 2 as a prefix, a single or doubled lined
+;;; comment box is forced. Given 3 as a prefix, a Taarna style box is
+;;; forced, but you do not even want to hear about those. When a
+;;; negative prefix is given, the absolute value is used, but the
+;;; default style is changed. Any other value (like C-u alone) forces
+;;; the default box style.
+;;;
+;;; I observed rounded corners first in some code from Warren Tucker
+;;; <wht@n4hgf.mt-park.ga.us>.
+
+(defvar c-box-default-style 'single "*Preferred style for box comments.")
+(defvar c-mode-taarna-style nil "*Non-nil for Taarna team C-style.")
+
+;;; Set or reset the Taarna team's own way for a C style.
+
+(defun taarna-mode ()
+ (interactive)
+ (if c-mode-taarna-style
+ (progn
+
+ (setq c-mode-taarna-style nil)
+ (setq c-indent-level 2)
+ (setq c-continued-statement-offset 2)
+ (setq c-brace-offset 0)
+ (setq c-argdecl-indent 5)
+ (setq c-label-offset -2)
+ (setq c-tab-always-indent t)
+ (setq c-box-default-style 'single)
+ (message "C mode: GNU style"))
+
+ (setq c-mode-taarna-style t)
+ (setq c-indent-level 4)
+ (setq c-continued-statement-offset 4)
+ (setq c-brace-offset -4)
+ (setq c-argdecl-indent 4)
+ (setq c-label-offset -4)
+ (setq c-tab-always-indent t)
+ (setq c-box-default-style 'taarna)
+ (message "C mode: Taarna style")))
+
+;;; Return the minimum value of the left margin of all lines, or -1 if
+;;; all lines are empty.
+
+(defun buffer-left-margin ()
+ (let ((margin -1))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (skip-chars-forward " \t")
+ (if (not (looking-at "\n"))
+ (setq margin
+ (if (< margin 0)
+ (current-column)
+ (min margin (current-column)))))
+ (forward-line 1))
+ margin))
+
+;;; Return the maximum value of the right margin of all lines. Any
+;;; sentence ending a line has a space guaranteed before the margin.
+
+(defun buffer-right-margin ()
+ (let ((margin 0) period)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (end-of-line)
+ (if (bobp)
+ (setq period 0)
+ (backward-char 1)
+ (setq period (if (looking-at "[.?!]") 1 0))
+ (forward-char 1))
+ (setq margin (max margin (+ (current-column) period)))
+ (forward-char 1))
+ margin))
+
+;;; Add, delete or adjust a C comment box. If FLAG is nil, the
+;;; current boxing style is recognized and preserved. When 0, the box
+;;; is removed; when 1, a single lined box is forced; when 2, a double
+;;; lined box is forced; when 3, a Taarna style box is forced. If
+;;; negative, the absolute value is used, but the default style is
+;;; changed. For any other value (like C-u), the default style is
+;;; forced. If REFILL is not nil, refill the comment paragraphs prior
+;;; to reboxing.
+
+(defun rebox-c-comment-engine (flag refill)
+ (save-restriction
+ (let ((undo-list buffer-undo-list)
+ (marked-point (point-marker))
+ (saved-point (point))
+ box-style left-margin right-margin)
+
+ ;; First, find the limits of the block of comments following or
+ ;; enclosing the cursor, or return an error if the cursor is not
+ ;; within such a block of comments, narrow the buffer, and
+ ;; untabify it.
+
+ ;; - insure the point is into the following comment, if any
+
+ (skip-chars-forward " \t\n")
+ (if (looking-at "/\\*")
+ (forward-char 2))
+
+ (let ((here (point)) start end temp)
+
+ ;; - identify a minimal comment block
+
+ (search-backward "/*")
+ (setq temp (point))
+ (beginning-of-line)
+ (setq start (point))
+ (skip-chars-forward " \t")
+ (if (< (point) temp)
+ (progn
+ (goto-char saved-point)
+ (error "text before comment's start")))
+ (search-forward "*/")
+ (setq temp (point))
+ (end-of-line)
+ (if (looking-at "\n")
+ (forward-char 1))
+ (setq end (point))
+ (skip-chars-backward " \t\n")
+ (if (> (point) temp)
+ (progn
+ (goto-char saved-point)
+ (error "text after comment's end")))
+ (if (< end here)
+ (progn
+ (goto-char saved-point)
+ (error "outside any comment block")))
+
+ ;; - try to extend the comment block backwards
+
+ (goto-char start)
+ (while (and (not (bobp))
+ (progn (previous-line 1)
+ (beginning-of-line)
+ (looking-at "[ \t]*/\\*.*\\*/[ \t]*$")))
+ (setq start (point)))
+
+ ;; - try to extend the comment block forward
+
+ (goto-char end)
+ (while (looking-at "[ \t]*/\\*.*\\*/[ \t]*$")
+ (forward-line 1)
+ (beginning-of-line)
+ (setq end (point)))
+
+ ;; - narrow to the whole block of comments
+
+ (narrow-to-region start end))
+
+ ;; Second, remove all the comment marks, and move all the text
+ ;; rigidly to the left to insure the left margin stays at the
+ ;; same place. At the same time, recognize and save the box
+ ;; style in BOX-STYLE.
+
+ (let ((previous-margin (buffer-left-margin))
+ actual-margin)
+
+ ;; - remove all comment marks
+
+ (goto-char (point-min))
+ (replace-regexp "^\\([ \t]*\\)/\\*" "\\1 ")
+ (goto-char (point-min))
+ (replace-regexp "^\\([ \t]*\\)|" "\\1 ")
+ (goto-char (point-min))
+ (replace-regexp "\\(\\*/\\||\\)[ \t]*" "")
+ (goto-char (point-min))
+ (replace-regexp "\\*/[ \t]*/\\*" " ")
+
+ ;; - remove the first and last dashed lines
+
+ (setq box-style 'plain)
+ (goto-char (point-min))
+ (if (looking-at "^[ \t]*-*[.\+\\]?[ \t]*\n")
+ (progn
+ (setq box-style 'single)
+ (replace-match ""))
+ (if (looking-at "^[ \t]*=*[.\+\\]?[ \t]*\n")
+ (progn
+ (setq box-style 'double)
+ (replace-match ""))))
+ (goto-char (point-max))
+ (previous-line 1)
+ (beginning-of-line)
+ (if (looking-at "^[ \t]*[`\+\\]?*[-=]+[ \t]*\n")
+ (progn
+ (if (eq box-style 'plain)
+ (setq box-style 'taarna))
+ (replace-match "")))
+
+ ;; - remove all spurious whitespace
+
+ (goto-char (point-min))
+ (replace-regexp "[ \t]+$" "")
+ (goto-char (point-min))
+ (if (looking-at "\n+")
+ (replace-match ""))
+ (goto-char (point-max))
+ (skip-chars-backward "\n")
+ (if (looking-at "\n\n+")
+ (replace-match "\n"))
+ (goto-char (point-min))
+ (replace-regexp "\n\n\n+" "\n\n")
+
+ ;; - move the text left is adequate
+
+ (setq actual-margin (buffer-left-margin))
+ (if (not (= previous-margin actual-margin))
+ (indent-rigidly (point-min) (point-max)
+ (- previous-margin actual-margin))))
+
+ ;; Third, select the new box style from the old box style and
+ ;; the argument, choose the margins for this style and refill
+ ;; each paragraph.
+
+ ;; - modify box-style only if flag is defined
+
+ (if flag
+ (setq box-style
+ (cond ((eq flag 0) 'plain)
+ ((eq flag 1) 'single)
+ ((eq flag 2) 'double)
+ ((eq flag 3) 'taarna)
+ ((eq flag '-) (setq c-box-default-style 'plain) 'plain)
+ ((eq flag -1) (setq c-box-default-style 'single) 'single)
+ ((eq flag -2) (setq c-box-default-style 'double) 'double)
+ ((eq flag -3) (setq c-box-default-style 'taarna) 'taarna)
+ (t c-box-default-style))))
+
+ ;; - compute the left margin
+
+ (setq left-margin (buffer-left-margin))
+
+ ;; - temporarily set the fill prefix and column, then refill
+
+ (untabify (point-min) (point-max))
+
+ (if refill
+ (let ((fill-prefix (make-string left-margin ? ))
+ (fill-column (- fill-column
+ (if (memq box-style '(single double)) 4 6))))
+ (fill-region (point-min) (point-max))))
+
+ ;; - compute the right margin after refill
+
+ (setq right-margin (buffer-right-margin))
+
+ ;; Fourth, put the narrowed buffer back into a comment box,
+ ;; according to the value of box-style. Values may be:
+ ;; plain: insert between a single pair of comment delimiters
+ ;; single: complete box, overline and underline with dashes
+ ;; double: complete box, overline and underline with equal signs
+ ;; taarna: comment delimiters on each line, underline with dashes
+
+ ;; - move the right margin to account for left inserts
+
+ (setq right-margin (+ right-margin
+ (if (memq box-style '(single double))
+ 2
+ 3)))
+
+ ;; - construct the box comment, from top to bottom
+
+ (goto-char (point-min))
+ (cond ((eq box-style 'plain)
+
+ ;; - construct a plain style comment
+
+ (skip-chars-forward " " (+ (point) left-margin))
+ (insert (make-string (- left-margin (current-column)) ? )
+ "/* ")
+ (end-of-line)
+ (forward-char 1)
+ (while (not (eobp))
+ (skip-chars-forward " " (+ (point) left-margin))
+ (insert (make-string (- left-margin (current-column)) ? )
+ " ")
+ (end-of-line)
+ (forward-char 1))
+ (backward-char 1)
+ (insert " */"))
+ ((eq box-style 'single)
+
+ ;; - construct a single line style comment
+
+ (indent-to left-margin)
+ (insert "/*")
+ (insert (make-string (- right-margin (current-column)) ?-)
+ "-.\n")
+ (while (not (eobp))
+ (skip-chars-forward " " (+ (point) left-margin))
+ (insert (make-string (- left-margin (current-column)) ? )
+ "| ")
+ (end-of-line)
+ (indent-to right-margin)
+ (insert " |")
+ (forward-char 1))
+ (indent-to left-margin)
+ (insert "`")
+ (insert (make-string (- right-margin (current-column)) ?-)
+ "*/\n"))
+ ((eq box-style 'double)
+
+ ;; - construct a double line style comment
+
+ (indent-to left-margin)
+ (insert "/*")
+ (insert (make-string (- right-margin (current-column)) ?=)
+ "=\\\n")
+ (while (not (eobp))
+ (skip-chars-forward " " (+ (point) left-margin))
+ (insert (make-string (- left-margin (current-column)) ? )
+ "| ")
+ (end-of-line)
+ (indent-to right-margin)
+ (insert " |")
+ (forward-char 1))
+ (indent-to left-margin)
+ (insert "\\")
+ (insert (make-string (- right-margin (current-column)) ?=)
+ "*/\n"))
+ ((eq box-style 'taarna)
+
+ ;; - construct a Taarna style comment
+
+ (while (not (eobp))
+ (skip-chars-forward " " (+ (point) left-margin))
+ (insert (make-string (- left-margin (current-column)) ? )
+ "/* ")
+ (end-of-line)
+ (indent-to right-margin)
+ (insert " */")
+ (forward-char 1))
+ (indent-to left-margin)
+ (insert "/* ")
+ (insert (make-string (- right-margin (current-column)) ?-)
+ " */\n"))
+ (t (error "unknown box style")))
+
+ ;; Fifth, retabify, restore the point position, then cleanup the
+ ;; undo list of any boundary since we started.
+
+ ;; - retabify before left margin only (adapted from tabify.el)
+
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t][ \t][ \t]*" nil t)
+ (let ((column (current-column))
+ (indent-tabs-mode t))
+ (delete-region (match-beginning 0) (point))
+ (indent-to column)))
+
+ ;; - restore the point position
+
+ (goto-char (marker-position marked-point))
+
+ ;; - remove all intermediate boundaries from the undo list
+
+ (if (not (eq buffer-undo-list undo-list))
+ (let ((cursor buffer-undo-list))
+ (while (not (eq (cdr cursor) undo-list))
+ (if (car (cdr cursor))
+ (setq cursor (cdr cursor))
+ (rplacd cursor (cdr (cdr cursor))))))))))
+
+;;; Rebox a C comment without refilling it.
+
+(defun rebox-c-comment (flag)
+ (interactive "P")
+ (rebox-c-comment-engine flag nil))
+
+;;; Rebox a C comment after refilling.
+
+(defun reindent-c-comment (flag)
+ (interactive "P")
+ (rebox-c-comment-engine flag t))
+
diff --git a/custom/edit-indirect.el b/custom/edit-indirect.el
new file mode 100644
index 00000000..307f9695
--- /dev/null
+++ b/custom/edit-indirect.el
@@ -0,0 +1,440 @@
+;;; edit-indirect.el --- Edit regions in separate buffers -*- lexical-binding: t -*-
+
+;; Author: Fanael Linithien <fanael4@gmail.com>
+;; URL: https://github.com/Fanael/edit-indirect
+;; Version: 0.1.10
+;; Package-Requires: ((emacs "24.3"))
+
+;; This file is NOT part of GNU Emacs.
+
+;; SPDX-License-Identifier: BSD-2-clause
+;;
+;; Copyright (c) 2014-2022, Fanael Linithien
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * Redistributions in binary form must reproduce the above copyright
+;; notice, this list of conditions and the following disclaimer in the
+;; documentation and/or other materials provided with the distribution.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+;;; Commentary:
+
+;; Edit regions in separate buffers, like `org-edit-src-code' but for arbitrary
+;; regions.
+;;
+;; See the docstring of `edit-indirect-region' for details.
+
+;;; Code:
+(defgroup edit-indirect nil
+ "Editing regions in separate buffers."
+ :group 'editing)
+
+(defcustom edit-indirect-guess-mode-function #'edit-indirect-default-guess-mode
+ "The function used to guess the major mode of an edit-indirect buffer.
+It's called with the edit-indirect buffer as the current buffer.
+It's called with three arguments, the parent buffer, the beginning
+and the end of the parent buffer region being editing.
+
+Note that the buffer-local value from the parent buffer is used."
+ :type 'function
+ :group 'edit-indirect)
+
+(defcustom edit-indirect-after-creation-hook nil
+ "Functions called after the edit-indirect buffer is created.
+The functions are called with the edit-indirect buffer as the
+current buffer.
+
+Note that the buffer-local value from the parent buffer is used."
+ :type 'hook
+ :group 'edit-indirect)
+
+(defcustom edit-indirect-before-commit-hook nil
+ "Functions called before the edit-indirect buffer is committed.
+The functions are called with the edit-indirect buffer as the
+current buffer.
+
+Note that the buffer-local value from the edit-indirect buffer is
+used."
+ :type 'hook
+ :group 'edit-indirect)
+
+(defcustom edit-indirect-before-commit-functions nil
+ "Functions called before an edit-indirect buffer is committed.
+The functions are called with the parent buffer as the current
+buffer.
+Each function is called with two arguments, the beginning and the
+end of the region to be changed."
+ :type 'hook
+ :group 'edit-indirect)
+
+(defcustom edit-indirect-after-commit-functions nil
+ "Functions called after an edit-indirect buffer has been committed.
+The functions are called with the parent buffer as the current
+buffer.
+Each function is called with two arguments, the beginning and the
+end of the changed region."
+ :type 'hook
+ :group 'edit-indirect)
+
+(defgroup edit-indirect-faces nil
+ "Faces used in `edit-indirect'."
+ :group 'edit-indirect
+ :group 'faces
+ :prefix "edit-indirect")
+
+(defface edit-indirect-edited-region
+ '((t :inherit secondary-selection))
+ "Face used to highlight an indirectly edited region."
+ :group 'edit-indirect-faces)
+
+;; Emacs <= 24.3 has no `define-error'.
+(let* ((user-error-conditions (get 'user-error 'error-conditions))
+ (define-user-error (lambda (name message)
+ (put name 'error-conditions
+ (cons name user-error-conditions))
+ (put name 'error-message message))))
+ (funcall define-user-error 'edit-indirect-overlapping
+ "Indirectly edited regions cannot overlap")
+ (funcall define-user-error 'edit-indirect-read-only
+ "Text is read-only, modify the edit-indirect buffer instead")
+ (funcall define-user-error 'edit-indirect-not-indirect
+ "This is not an edit-indirect buffer"))
+
+(defvar edit-indirect--overlay)
+(defvar edit-indirect--should-quit-window nil)
+(put 'edit-indirect--should-quit-window 'permanent-local t)
+
+;;;###autoload
+(defun edit-indirect-region (beg end &optional display-buffer)
+ "Edit the region BEG..END in a separate buffer.
+The region is copied, without text properties, to a separate
+buffer, called edit-indirect buffer, and
+`edit-indirect-guess-mode-function' is called to set the major
+mode.
+When done, exit with `edit-indirect-commit', which will remove the
+original region and replace it with the edited version; or with
+`edit-indirect-abort', which will drop the modifications.
+
+This differs from `clone-indirect-buffer' with narrowing in that
+the text properties are not shared, so the parent buffer major mode
+and the edit-indirect buffer major mode will not be able to tread
+on each other's toes by setting up potentially conflicting text
+properties, which happens surprisingly often when the font-lock
+mode is used.
+
+Edit-indirect buffers use the `edit-indirect-mode-map' keymap.
+Regions with active edit-indirect buffers use the
+`edit-indirect-overlay-map' keymap.
+
+If there's already an edit-indirect buffer for BEG..END, use that.
+If there's already an edit-indirect buffer active overlapping any
+portion of BEG..END, an `edit-indirect-overlapping' error is
+signaled.
+
+When DISPLAY-BUFFER is non-nil or when called interactively,
+display the edit-indirect buffer in some window and select it.
+
+In any case, return the edit-indirect buffer."
+ (interactive
+ (if (or (use-region-p) (not transient-mark-mode))
+ (prog1 (list (region-beginning) (region-end) t)
+ (deactivate-mark))
+ (user-error "No region")))
+ (let ((buffer (edit-indirect--get-edit-indirect-buffer beg end)))
+ (when display-buffer
+ (edit-indirect--display-buffer buffer))
+ buffer))
+
+(defvar edit-indirect-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [remap save-buffer] #'edit-indirect-save)
+ (define-key map (kbd "C-c '") #'edit-indirect-commit)
+ (define-key map (kbd "C-c C-c") #'edit-indirect-commit)
+ (define-key map (kbd "C-c C-k") #'edit-indirect-abort)
+ map)
+ "Keymap for edit-indirect buffers.
+
+\\{edit-indirect-mode-map}")
+
+(defvar edit-indirect-overlay-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "RET") #'edit-indirect-display-active-buffer)
+ map)
+ "Keymap for regions with active edit-indirect buffers.
+
+\\{edit-indirect-overlay-map}")
+
+(defun edit-indirect-commit ()
+ "Commit the modifications done in an edit-indirect buffer.
+That is, replace the original region in the parent buffer with the
+contents of the edit-indirect buffer.
+The edit-indirect buffer is then killed.
+
+Can be called only when the current buffer is an edit-indirect
+buffer."
+ (interactive)
+ (edit-indirect--barf-if-not-indirect)
+ (edit-indirect--commit)
+ (edit-indirect--clean-up))
+
+(defun edit-indirect-save ()
+ "Save the modifications done in an edit-indirect buffer.
+That is, replace the original region in the parent buffer with the
+contents of the edit-indirect buffer.
+
+Can be called only when the current buffer is an edit-indirect
+buffer."
+ (interactive)
+ (edit-indirect--barf-if-not-indirect)
+ (edit-indirect--commit))
+
+(defun edit-indirect-abort ()
+ "Abort indirect editing in the current buffer and kill the buffer.
+
+Can be called only when the current buffer is an edit-indirect
+buffer."
+ (interactive)
+ (edit-indirect--barf-if-not-indirect)
+ (edit-indirect--abort))
+
+(defun edit-indirect-buffer-indirect-p (&optional buffer)
+ "Non-nil iff the BUFFER is an edit-indirect buffer.
+BUFFER defaults to the current buffer."
+ (save-current-buffer
+ (when buffer
+ (set-buffer buffer))
+ ;; (not (null)) so we don't leak the overlay to the outside world.
+ (not (null edit-indirect--overlay))))
+
+(defun edit-indirect-default-guess-mode (_parent-buffer _beg _end)
+ "Guess the major mode for an edit-indirect buffer.
+It's done by calling `normal-mode'."
+ (normal-mode))
+
+(defun edit-indirect-display-active-buffer ()
+ "Display the active edit-indirect buffer of the region the point is in."
+ (interactive)
+ (let ((overlay
+ (let ((p (point)))
+ (edit-indirect--search-for-edit-indirect p (1+ p)))))
+ (unless overlay
+ (signal 'edit-indirect-not-indirect '()))
+ (edit-indirect--display-buffer (overlay-get overlay 'edit-indirect-buffer))))
+
+(defvar edit-indirect--overlay nil
+ "The overlay spanning the region of the parent buffer being edited.
+
+It's also used as the variable determining if we're in an
+edit-indirect buffer at all.")
+(make-variable-buffer-local 'edit-indirect--overlay)
+(put 'edit-indirect--overlay 'permanent-local t)
+
+;; Normally this would use `define-minor-mode', but that makes the mode function
+;; interactive, which we don't want, because it's just an implementation detail.
+(defun edit-indirect--mode (overlay)
+ "Turn the `edit-indirect--mode' \"minor mode\" on.
+OVERLAY is the value to set `edit-indirect--overlay' to."
+ (setq edit-indirect--overlay overlay)
+ (add-hook 'kill-buffer-hook #'edit-indirect--abort-on-kill-buffer nil t))
+(with-no-warnings
+ (add-minor-mode
+ 'edit-indirect--overlay " indirect" edit-indirect-mode-map nil #'ignore))
+
+(defun edit-indirect--display-buffer (buffer)
+ "Display the given BUFFER in some window and select it."
+ (with-current-buffer buffer
+ (setq-local edit-indirect--should-quit-window t))
+ (select-window (display-buffer buffer))
+ nil)
+
+(defun edit-indirect--get-edit-indirect-buffer (beg end)
+ "Return an edit-indirect buffer for the region BEG..END.
+If there's already an edit-indirect buffer active overlapping any
+portion of BEG..END, an `edit-indirect-overlapping' error is
+signaled."
+ (let ((old-overlay (edit-indirect--search-for-edit-indirect beg end)))
+ (cond
+ ((null old-overlay)
+ (let ((overlay (edit-indirect--create-overlay beg end)))
+ (edit-indirect--create-indirect-buffer beg end overlay)))
+ ((and (= beg (overlay-start old-overlay))
+ (= end (overlay-end old-overlay)))
+ (overlay-get old-overlay 'edit-indirect-buffer))
+ (t
+ (signal 'edit-indirect-overlapping '())))))
+
+(defun edit-indirect--search-for-edit-indirect (beg end)
+ "Return an existing edit-indirect overlay for some region inside BEG..END.
+If there's no indirectly edited region inside BEG..END, return
+nil."
+ (catch 'done
+ (dolist (overlay (overlays-in beg end))
+ (when (overlay-get overlay 'edit-indirect-buffer)
+ (throw 'done overlay)))
+ nil))
+
+(defmacro edit-indirect--buffer-local-value (buffer variable)
+ "Get the BUFFER local value of VARIABLE.
+VARIABLE shall be a symbol."
+ (unless (symbolp variable)
+ (signal 'wrong-type-argument (list #'symbolp variable)))
+ ;; `with-current-buffer' is used instead of `buffer-local-value' because
+ ;; the latter doesn't give warnings about free variables when
+ ;; byte-compiled.
+ `(with-current-buffer ,buffer ,variable))
+
+(defun edit-indirect--create-indirect-buffer (beg end overlay)
+ "Create an edit-indirect buffer and return it.
+
+BEG..END is the parent buffer region to insert.
+OVERLAY is the overlay, see `edit-indirect--overlay'."
+ (add-hook 'after-change-major-mode-hook #'edit-indirect--rebind-save-hooks)
+ (let ((buffer (generate-new-buffer (format "*edit-indirect %s*" (buffer-name))))
+ (parent-buffer (current-buffer)))
+ (overlay-put overlay 'edit-indirect-buffer buffer)
+ (with-current-buffer buffer
+ (insert-buffer-substring-no-properties parent-buffer beg end)
+ (set-buffer-modified-p nil)
+ (edit-indirect--mode overlay)
+ ;; Use the buffer-local values from the parent buffer. Don't retrieve the
+ ;; values before actual uses in case these variables are changed by some
+ ;; of the many possible hooks.
+ (funcall (edit-indirect--buffer-local-value
+ parent-buffer edit-indirect-guess-mode-function)
+ parent-buffer beg end)
+ (if (local-variable-p 'edit-indirect-after-creation-hook parent-buffer)
+ ;; Copy the parent buffer hook to the indirect buffer instead of
+ ;; let-binding it to avoid running it twice.
+ (setq-local edit-indirect-after-creation-hook
+ (edit-indirect--buffer-local-value
+ parent-buffer edit-indirect-after-creation-hook))
+ ;; No need to do copy anything if the parent buffer has no local value,
+ ;; the global value will be used instead. Just kill the local value in
+ ;; the indirect buffer in case a prior hook set it, because we're not
+ ;; supposed to use it.
+ (kill-local-variable 'edit-indirect-after-creation-hook))
+ (run-hooks 'edit-indirect-after-creation-hook))
+ buffer))
+
+(defun edit-indirect--create-overlay (beg end)
+ "Create the edit-indirect overlay and return it.
+
+BEG and END specify the region the overlay should encompass."
+ (let ((overlay (make-overlay beg end)))
+ (overlay-put overlay 'face 'edit-indirect-edited-region)
+ (overlay-put overlay 'modification-hooks '(edit-indirect--barf-read-only))
+ (overlay-put overlay 'insert-in-front-hooks '(edit-indirect--barf-read-only))
+ (overlay-put overlay 'keymap edit-indirect-overlay-map)
+ overlay))
+
+(defvar edit-indirect--inhibit-read-only nil
+ "Non-nil means disregard read-only status of indirectly-edited region.")
+
+(defun edit-indirect--barf-read-only (_ov _after _beg _end &optional _len)
+ "Signal an error because the text is read-only.
+No error is signaled if `inhibit-read-only' or
+`edit-indirect--inhibit-read-only' is non-nil."
+ (unless (or inhibit-read-only edit-indirect--inhibit-read-only)
+ (signal 'edit-indirect-read-only '())))
+
+(defun edit-indirect--commit ()
+ "Commit the modifications done in an edit-indirect buffer."
+ (run-hooks 'edit-indirect-before-commit-hook)
+ (let ((beg (overlay-start edit-indirect--overlay))
+ (end (overlay-end edit-indirect--overlay))
+ (buffer (current-buffer))
+ (edit-indirect--inhibit-read-only t))
+ (with-current-buffer (overlay-buffer edit-indirect--overlay)
+ (save-excursion
+ (let ((beg-marker (copy-marker beg))
+ (end-marker (copy-marker end)))
+ (edit-indirect--run-hook-with-positions
+ 'edit-indirect-before-commit-functions beg-marker end-marker)
+ (save-match-data
+ (set-match-data (list beg-marker end-marker))
+ (let ((new-data
+ (with-current-buffer buffer
+ (buffer-substring-no-properties 1 (1+ (buffer-size))))))
+ (unless (string= new-data (match-string 0))
+ (replace-match new-data t t))))
+ (edit-indirect--run-hook-with-positions
+ 'edit-indirect-after-commit-functions beg-marker (point))
+ (set-marker beg-marker nil)
+ (set-marker end-marker nil))))
+ (set-buffer-modified-p nil)))
+
+(defun edit-indirect--run-hook-with-positions (hook beg end)
+ "Run HOOK with the specified positions BEG and END.
+HOOK should be a symbol, a hook variable.
+The functions are passed integer positions.
+If a function changes the buffer contents, the next function will be
+called with updated positions."
+ (let ((beg-marker (unless (markerp beg) (copy-marker beg)))
+ (end-marker (unless (markerp end) (copy-marker end))))
+ (run-hook-wrapped hook
+ (lambda (f beg end)
+ (funcall f (marker-position beg) (marker-position end))
+ nil)
+ (or beg-marker beg) (or end-marker end))
+ (when beg-marker (set-marker beg-marker nil))
+ (when end-marker (set-marker end-marker nil))))
+
+(defun edit-indirect--abort ()
+ "Abort indirect edit."
+ (edit-indirect--clean-up))
+
+(defun edit-indirect--clean-up ()
+ "Clean up an edit-indirect buffer."
+ (delete-overlay edit-indirect--overlay)
+ ;; Kill the overlay reference so that `edit-indirect--abort-on-kill-buffer'
+ ;; won't try to call us again.
+ (setq edit-indirect--overlay nil)
+ ;; If we created a window, get rid of it. Kill the buffer we created.
+ (if edit-indirect--should-quit-window
+ (quit-window t)
+ (kill-buffer)))
+
+(defun edit-indirect--rebind-save-hooks ()
+ "Bind our `save-buffer' hooks in the current buffer.
+Does nothing if the current buffer is not an edit-indirect buffer."
+ (when (edit-indirect-buffer-indirect-p)
+ (setq buffer-offer-save t)
+ (add-hook 'write-contents-functions #'edit-indirect--commit-on-save nil t)))
+
+(defun edit-indirect--commit-on-save ()
+ "Commit the indirect edit.
+Should only be called from `write-contents-functions'."
+ (edit-indirect--commit)
+ t)
+
+(defun edit-indirect--abort-on-kill-buffer ()
+ "Abort indirect edit.
+Should be called only from `kill-buffer-hook'."
+ (when edit-indirect--overlay
+ (edit-indirect--abort)))
+
+(defun edit-indirect--barf-if-not-indirect ()
+ "Signal an error if the current buffer is not an edit-indirect buffer.
+The error signaled is `edit-indirect-not-indirect'."
+ (unless edit-indirect--overlay
+ (signal 'edit-indirect-not-indirect '())))
+
+(provide 'edit-indirect)
+;;; edit-indirect.el ends here
diff --git a/custom/elpa-mirror.el b/custom/elpa-mirror.el
new file mode 100644
index 00000000..777293e2
--- /dev/null
+++ b/custom/elpa-mirror.el
@@ -0,0 +1,450 @@
+;;; elpa-mirror.el --- Create local package repository from installed packages
+
+;; Copyright (C) 2014-2020 Chen Bin
+
+;; Author: Chen Bin <chenbin.sh@gmail.com>
+;; URL: http://github.com/redguardtoo/elpa-mirror
+;; Package-Requires: ((emacs "25.1"))
+;; Version: 2.2.2
+;; Keywords: tools
+;;
+;; This file is not part of GNU Emacs.
+
+;;; License:
+
+;; This file is part of elpa-mirror
+;;
+;; elpa-mirror 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.
+;;
+;; elpa-mirror 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:
+
+;; This program will create a local package repository by from all
+;; installed packages.
+;;
+;; Please note compile Emacs Lisp file (*.elc) from one version of Emacs
+;; might not work with another version of Emacs. So you need this program
+;; to compile package from local repository.
+;;
+;; This is the ONLY way to have 100% portable Emacs setup.
+;;
+;; Usage in Emacs,
+;; Run `elpamr-create-mirror-for-installed'.
+;;
+;; CLI program tar is required. It's bundled with Windows10/Linux/macOS.
+;;
+;; Usage in Shell,
+;; Emacs --batch -l ~/.emacs.d/init.el
+;; -l ~/any-directory-you-prefer/elpa-mirror.el \
+;; --eval='(setq elpamr-default-output-directory "~/myelpa")' \
+;; --eval='(elpamr-create-mirror-for-installed)
+;;
+;; Use the repository created by elpa-mirror,
+;; - Add `(setq package-archives '(("myelpa" . "~/myelpa/")))` into ~/.emacs
+;; - Restart Emacs
+;;
+;; Tips,
+;; - `elpamr-exclude-packages' excludes packages
+;;
+;; - `elpamr-tar-command-exclude-patterns' excludes file and directories in
+;; package directory.
+;;
+;; - `elpamr-exclude-patterns-filter-function' lets users define a function to
+;; exclude files and directories per package.
+;;
+;; Below setup adds directory "bin/" into package "vagrant-tramp".
+;;
+;; (setq elpamr-exclude-patterns-filter-function
+;; (lambda (package-dir)
+;; (let ((patterns elpamr-tar-command-exclude-patterns))
+;; (when (string-match "vagrant-tramp" package-dir)
+;; (setq patterns (remove "*/bin" patterns)))
+;; patterns)))
+
+;; - You can also setup repositories on Dropbox and Github.
+;; See https://github.com/redguardtoo/elpa-mirror for details.
+;;
+
+;;; Code:
+(require 'package)
+
+(defcustom elpamr-default-output-directory nil
+ "The output directory use by `elpamr-create-mirror-for-installed'."
+ :type '(choice directory (const :tags "None" nil))
+ :group 'elpa-mirror)
+
+(defcustom elpamr-exclude-packages nil
+ "Names of excluded packages."
+ :type '(repeat string)
+ :group 'elpa-mirror)
+
+(defcustom elpamr-tar-command-exclude-patterns
+ '("*.elc"
+ "*~"
+ "*autoloads.el"
+ "*.so"
+ "*.dylib"
+ "*.dll"
+ "*/bin"
+ "*/__pycache__")
+ "Exclude patterns passed tar's `--exclude' option.
+
+The patterns use shell glob syntax, not regexp syntax:
+
+* `*' matches any string, including `/'.
+* `?' matches a single character.
+* `[abc]' or `[a-z]' is a character class.
+* `[^a-z]' or `[!a-z]' is a negated character class.
+* `^' and `$' have a special meaning in BSD tar only.
+* Special characters are quoted with `\\'.
+
+The patterns are anchored, meaning that they always start
+matching at the start of the path. This is done by passing the
+`--anchored' option when running with GNU tar, or pre-pending `^'
+to every pattern when running with BSD tar.
+
+Examples:
+
+* Exclude files/directories that end with `.elc': `*.elc'.
+* Exclude files/directories named `__pycache__': `*/__pycache__'.
+* Exclude `bin' inside the `company' package: `company-*/bin'.
+
+Note that a slash at the start or the end of a pattern will cause
+it to match nothing."
+ :type '(repeat string)
+ :group 'elpa-mirror)
+
+(defcustom elpamr-exclude-patterns-filter-function nil
+ "Filter `elpamr-tar-command-exclude-patterns' before using it per package.
+A function with one parameter which is the package directory.
+It returns the result to replace `elpamr-tar-command-exclude-patterns'."
+ :group 'elpa-mirror
+ :type 'hook)
+
+(defcustom elpamr-tar-executable
+ "tar"
+ "The tar executable used by elpa-mirror.
+It can be BSD tar, but GNU tar is preferred."
+ :type 'string
+ :group 'elpa-mirror)
+
+(defcustom elpamr-finished-hook nil
+ "Hook run when command `elpamr-create-mirror-for-installed' run finished.
+The hook function have one argument: output-directory."
+ :group 'elpa-mirror
+ :type 'hook)
+
+(defcustom elpamr-enable-log nil
+ "Enable log."
+ :type 'boolean
+ :group 'elpa-mirror)
+
+(defvar elpamr--log-buffer "*elpa-mirror log*"
+ "Destination buffer for log messages and command output.")
+
+(defun elpamr--log (format-string &rest args)
+ "Format ARGS with FORMAT-STRING, add the result to the log, and return it.
+The log line will be pre-pended with an asterisk to distinguish it
+from program output."
+ (when elpamr-enable-log
+ (let ((line (apply #'format format-string args)))
+ (with-current-buffer (get-buffer-create elpamr--log-buffer)
+ (insert "* " line "\n"))
+ line)))
+
+(defun elpamr--log-message (format-string &rest args)
+ "Format ARGS with FORMAT-STRING, add the result to the log and display it."
+ (when elpamr-enable-log
+ (apply #'elpamr--log format-string args)
+ (apply #'message format-string args)))
+
+(defun elpamr--log-error (format-string &rest args)
+ "Format ARGS with FORMAT-STRING, add the result to the log and signal an error."
+ (when elpamr-enable-log
+(apply #'elpamr--log format-string args)
+ (apply #'error format-string args)))
+
+(defun elpamr--package-desc (item)
+ "Extract package information from ITEM."
+ (cadr item))
+
+(defun elpamr--is-bsd-tar ()
+ "Are we using BSD tar instead of GNU tar?"
+ (let* ((output (mapconcat #'identity (process-lines elpamr-tar-executable "--version") " "))
+ ;; @see https://github.com/redguardtoo/elpa-mirror/issues/37
+ ;; extra error message insert extra whitespace before "bsdtar"
+ (result (and output (string-match-p "\\(^[ \t]*\\|[ \t]\\)bsdtar" output))))
+ (elpamr--log "Detected tar variant: %s" (if result "BSD" "GNU"))
+ result))
+
+(defun elpamr--create-one-item-for-archive-contents (pkg)
+ "Access PKG extracted from `package-alist' directly."
+ (unless (member (symbol-name (car pkg)) elpamr-exclude-packages)
+ pkg))
+
+(defun elpamr--fullpath (parent file)
+ "Full path of 'PARENT/FILE'."
+ (let* ((result (file-truename (concat (file-name-as-directory parent) file))))
+ (elpamr--log "Converted to full path: %S %S -> %S" parent file result)
+ result))
+
+(defun elpamr--clean-package-description (description)
+ "Clean DESCRIPTION."
+ (replace-regexp-in-string "-\*-.*-\*-" ""
+ (replace-regexp-in-string "\"" "" description t)
+ t))
+
+(defun elpamr--get-dependency (item)
+ "Get ITEM dependency."
+ (package-desc-reqs (elpamr--package-desc item)))
+
+(defun elpamr--get-version (item)
+ "Get ITEM version."
+ (package-desc-version (elpamr--package-desc item)))
+
+(defun elpamr--get-summary (item)
+ "Get ITEM description."
+ (package-desc-summary (elpamr--package-desc item)))
+
+(defun elpamr--one-item-for-archive-contents (final-pkg)
+ "Format FINAL-PKG information into a string for archive-contents."
+ (format " (%s . [%S %S \"%s\" tar])\n"
+ (car final-pkg)
+ (elpamr--get-version final-pkg)
+ (elpamr--get-dependency final-pkg)
+ (elpamr--clean-package-description (elpamr--get-summary final-pkg))))
+
+(defun elpamr--call-process-check (arguments)
+ "Call run tar program with the ARGUMENTS.
+Log and signal an error if it exits with a non-zero status."
+ (let ((exit-status (apply #'call-process
+ elpamr-tar-executable
+ nil
+ (and elpamr-enable-log elpamr--log-buffer)
+ nil
+ arguments)))
+ (cond
+ ((not (= exit-status 0))
+ (elpamr--log-error
+ "Program %s exited with non-zero status %s, see the %s buffer for details"
+ elpamr-tar-executable exit-status elpamr--log-buffer)
+ )
+ (t
+ exit-status))))
+
+(defun elpamr--run-tar (working-dir out-file dir-to-archive is-bsd-tar)
+ "Run tar in order to archive DIR-TO-ARCHIVE into OUT-FILE.
+Paths are relative to WORKING-DIR.
+IS-BSD-TAR should be non-nil if this function should use a
+command compatible with BSD tar instead of GNU tar."
+ ;; We could detect BSD tar inside this function easily, but detecting it once
+ ;; and then passing it as an argument improves performance.
+ (let* ((exclude-opts (mapcar (lambda (s)
+ (concat "--exclude=" (if is-bsd-tar "^" "") s))
+ (if elpamr-exclude-patterns-filter-function
+ (funcall elpamr-exclude-patterns-filter-function
+ dir-to-archive)
+ elpamr-tar-command-exclude-patterns)))
+ ;; set pwd of process
+ (default-directory working-dir)
+ ;; create tar using GNU tar
+ (tar-args
+ `("cf" ,out-file
+ ,@(unless is-bsd-tar '("--anchored"))
+ ,@exclude-opts
+ ;; tar 1.14 NEWS,
+ ;; @see https://git.savannah.gnu.org/cgit/tar.git/plain/NEWS?id=release_1_14
+ ;; * New option --format allows to select the output archive format
+ ;; * The default output format can be selected at configuration time
+ ;; by presetting the environment variable DEFAULT_ARCHIVE_FORMAT.
+ ;; Allowed values are GNU, V7, OLDGNU and POSIX.
+ ,@(unless is-bsd-tar '("--format=gnu"))
+ ;; Improve reproducibility by not storing unnecessary metadata.
+ ;; These options are enough for archives in the GNU format, but if
+ ;; we ever switch to PAX, we'll need to add more (see
+ ;; <http://h2.jaguarpaw.co.uk/posts/reproducible-tar/> and
+ ;; <https://www.gnu.org/software/tar/manual/html_node/PAX-keywords.html>).
+ ,@(unless is-bsd-tar
+ ;; @see https://github.com/redguardtoo/elpa-mirror/issues/41
+ '("--owner=root"
+ "--group=root"
+ "--mtime=1970-01-01 00:00:00 UTC"))
+ "--" ,dir-to-archive))
+ ;; Don't archive macOS' file properties (see
+ ;; <https://superuser.com/q/259703>).
+ (process-environment (if (eq system-type 'darwin)
+ (cons "COPYFILE_DISABLE=" process-environment)
+ process-environment)))
+ (elpamr--log "Running tar: %S %S" elpamr-tar-executable tar-args)
+ (elpamr--call-process-check tar-args)))
+
+;;;###autoload
+(defun elpamr-version ()
+ "Current version."
+ (interactive)
+ (message "2.2.2"))
+
+(defun elpamr--win-executable-find (exe)
+ "Find EXE on windows."
+ (let* ((drivers '("c" "d" "e" "f"))
+ (i 0)
+ j
+ (dirs '(":\\\\cygwin64\\\\bin\\\\"
+ ":\\\\msys64\\\\usr\\\\bin\\\\"))
+ rlt)
+ (while (and (not rlt)
+ (< i (length dirs)))
+ (setq j 0)
+ (while (and (not rlt)
+ (< j (length drivers)))
+ (setq rlt (executable-find (concat (nth j drivers) (nth i dirs) exe)))
+ (setq j (1+ j)))
+ (setq i (1+ i)))
+ (unless rlt
+ ;; nothing found, fall back to exe
+ (setq rlt exe))
+ rlt))
+
+(defun elpamr-double-check-executable ()
+ "Make sure `elpamr-tar-executable' is executable."
+ (when (eq system-type 'windows-nt)
+
+ (cond
+ (elpamr-tar-executable
+ (unless (executable-find elpamr-tar-executable)
+ (setq elpamr-tar-executable (elpamr--win-executable-find elpamr-tar-executable))))
+
+ ((executable-find "tar")
+ (setq elpamr-tar-executable "tar")))))
+
+(defun elpamr-delete-directory (directory)
+ "Delete DIRECTORY."
+ (ignore-errors
+ (delete-directory directory t)))
+
+;;;###autoload
+(defun elpamr-create-mirror-for-installed (&optional output-directory recreate-directory)
+ "Export installed packages into a new directory.
+Create the html files for the mirror site.
+
+The first valid directory found from the below list
+will be used as mirror package's output directory:
+1. Argument: OUTPUT-DIRECTORY
+2. Variable: `elpamr-default-output-directory'
+3. Ask user to provide.
+
+When RECREATE-DIRECTORY is non-nil, OUTPUT-DIRECTORY
+will be deleted and recreated."
+ (interactive)
+
+ ;; find tar program on Windows if GNU tar from Cygwin/MYSYS2 is installed
+ ;; and current `elpamr-tar-executable' is NOT executable.
+ (elpamr-double-check-executable)
+
+ (let (final-pkg-list)
+
+ ;; Erase the log (in case of multiple consecutive calls to this function).
+ (when elpamr-enable-log
+ (with-current-buffer (get-buffer-create elpamr--log-buffer)
+ (erase-buffer)))
+
+ ;; Since Emacs 27, `package-initialize' is optional.
+ ;; but we still need it to initialize `package-alist'.
+ (unless package-alist (package-initialize))
+
+ ;; Quote from manual about package-alist:
+ ;; Alist of all packages available for activation.
+ ;; Each element has the form (PKG . DESCS), where PKG is a package
+ ;; name (a symbol) and DESCS is a non-empty list of `package-desc' structure,
+ ;; sorted by decreasing versions.
+ ;; Sorted for reproducibility.
+ (setq final-pkg-list
+ (let ((sorted-package-alist
+ (sort (copy-sequence package-alist)
+ (lambda (a b)
+ (string< (symbol-name (car a))
+ (symbol-name (car b)))))))
+ (delq nil (mapcar #'elpamr--create-one-item-for-archive-contents
+ sorted-package-alist))))
+
+ ;; set output directory
+ (setq output-directory
+ (cond ((and output-directory
+ (stringp output-directory))
+ (file-name-as-directory output-directory))
+ ((and elpamr-default-output-directory
+ (stringp elpamr-default-output-directory))
+ (file-name-as-directory elpamr-default-output-directory))
+ (t (read-directory-name "Output directory: "))))
+
+ ;; Delete output directory if we need a clean output directory
+ (when (and recreate-directory
+ (file-directory-p output-directory))
+ (elpamr--log-message "Re-creating %s" output-directory)
+ (elpamr-delete-directory output-directory))
+
+ ;; Create output directory if it does not exist.
+ (unless (file-directory-p output-directory)
+ (make-directory output-directory t))
+
+ (when (and (> (length final-pkg-list) 0)
+ output-directory
+ (file-directory-p output-directory))
+ (let ((tmp-dir (make-temp-file "elpa" t))
+ (is-bsd-tar (elpamr--is-bsd-tar))
+ (cnt 0))
+
+ (dolist (package final-pkg-list)
+ (let* ((pkg-dir (package-desc-dir (car (cdr package))))
+ (name (package-desc-name (car (cdr package))))
+ (version-str (package-version-join (package-desc-version (car (cdr package)))))
+ (name-fixed (format "%s-%s" name version-str))
+ (package-parent-dir-temp-p (not (string-match (concat "^" (file-truename package-user-dir))
+ pkg-dir)))
+ (package-parent-dir (cond
+ (package-parent-dir-temp-p
+ tmp-dir)
+ (t
+ package-user-dir))))
+
+ (when package-parent-dir-temp-p
+ (copy-directory pkg-dir (elpamr--fullpath tmp-dir name-fixed)))
+
+ (elpamr--run-tar package-parent-dir
+ (file-relative-name (concat (elpamr--fullpath output-directory name-fixed) ".tar")
+ package-parent-dir)
+ name-fixed
+ is-bsd-tar)
+ (message "Creating *.tar... %2d%% (%s)"
+ (/ (* cnt 100) (length final-pkg-list))
+ pkg-dir))
+ (setq cnt (1+ cnt)))
+ ;; clean up temp directory
+ (elpamr-delete-directory tmp-dir))
+
+ ;; output archive-contents
+ (elpamr--log-message "Creating archive-contents...")
+ (with-temp-buffer
+ (let* ((print-level nil)
+ (print-length nil))
+ (insert "(1\n")
+ (dolist (final-pkg final-pkg-list)
+ ;; each package occupies one line
+ (insert (elpamr--one-item-for-archive-contents final-pkg)))
+ (insert ")"))
+ (write-file (elpamr--fullpath output-directory "archive-contents")))
+ (run-hook-with-args 'elpamr-finished-hook output-directory)
+ (elpamr--log-message "DONE! Output directory: %s" output-directory))))
+
+(provide 'elpa-mirror)
+;;; elpa-mirror.el ends here
diff --git a/custom/faith.el b/custom/faith.el
new file mode 100644
index 00000000..8b25ff75
--- /dev/null
+++ b/custom/faith.el
@@ -0,0 +1,566 @@
+;;; faith.el --- hepls spreading the true faith
+;; Time-stamp: <2003-08-19 13:38:28 deego>
+;; GPL'ed under GNU'S public license..
+;; Copyright (C) Deepak Goel 2000
+;; Emacs Lisp Archive entry
+;; Filename: faith.el
+;; Author: Deepak Goel <deego@glue.umd.edu>
+;; Version: 1.9
+
+(defconst faith-version "1.9"
+ "Version number of faith.el")
+
+;; This file is not (yet) part of GNU Emacs.
+
+;; WEBSITE: http://www.glue.umd.edu/~deego/emacspub/faith/
+;; for this file and for associated READMEs LOGFILEs etc..
+
+;;; Copyright (C) Deepak Goel
+;; AUTHORS: Deepak Goel (deego@glue.umd.edu) ,
+;; Robert Fenk <Robert.Fenk@gmx.de>,
+;; Roberto Selbach Teixeira <teixeira@conectiva.com>
+;; Remi Vanicat<vanicat@labri.u-bordeaux.fr>
+
+;; YOU ARE VERY WELCOME TO CONTRIBUTE TO FAITH. YOUR SUGGESTIONS OR
+;; CONTRIBUTIONS OR CORRECTIONS WILL BE CONSIDERED VERY FAVORABLY,
+;; AND WILL PROVE YOUR UTMOST DEVOTION TO HIM. Even minor
+;; contributions to this holy work will earn you a name on the list
+;; of authors.
+
+;; If you have been invited to become priest (author) of faith,
+;; please send deego@glue.umd.edu an email agreeing to accept the
+;; "GNU FREEness" of faith, and agreeing that if at any point in
+;; future, you don't agree to sign the appropriate copyleft
+;; agreement, deego@glue.umd.edu will remove you from the author's
+;; list. You will be promptly listed as an author.
+
+;; Commentary: In this world of infidelity and blasphemy,
+;; FAITH tries to reinforce faith in you.
+
+;;; QUICKSTART INSTALLATION FOR THOSE LOST:
+;;; Drop faith.el somewhere in yr load-path, and add to your .emacs:
+;;; (load "faith.el")
+;;; then type M-x faith, and enjoy..
+
+
+;;; Code:
+(defconst faith-false-quotes nil
+ "BLASPHEMOUS QUOTES. DON'T LOOK!
+A variety of false quotes collected from various places. Collected so
+that the false names can be replaced by the TRUE ONE.")
+
+(defvar faith-user-quotes nil
+ "*These are any additional quotes a user might like included.")
+
+(defvar faith-quotes-separator "\n__________________________\n\n"
+ "*The string whis is inserted before a quote.")
+
+(defvar faith-replacement-strings nil
+ "True Replacements for bad Gods and other words.
+Is a list of REPLACEMENTS. Each replacement is a list of BADLIST and
+GOODLIST. All matches from BADLIST will be replaced by a random word
+from goodlist. For consistency, the random word chosen will be the
+same for the entire quote.")
+
+(defvar faith-user-before-replacement-strings nil
+ "Will be appended before faith-replacement-strings.
+Allow user to define their own replacements, and together with
+faith-user-after-replacement-strings, to completely edit the default
+replacement-strings.. in many many novel ways the wise user may come
+up with.. O user, from now on, you may customize your faith, should u
+like to..
+Also see faith-user-after-replacement-strings")
+
+(defvar faith-user-after-replacement-strings nil
+ "Will be appended after faith-replacement-strings.
+Allow user to define their own replacements.
+Also see faith-user-before-replacement-strings")
+
+;; THE 'false-quotes have been picked out of books whose authors are
+;; not likely to be in a position to object to the same. Current
+;; sources:
+;; Bible
+;; Koran
+
+
+;;;###autoload
+(defun faith-insert (&rest args)
+ "Insert a quote right here, right now, in the current buffer"
+ (interactive)
+ (insert (apply 'faith-quote args)))
+
+
+(defvar faith-fill-column 70)
+
+;; You might think some users might find no need for this
+;; 'faith function. But ask me! It makes testing so easier..
+;;;###autoload
+(defun faith ()
+ "Switch to buffer *faith* and insert faith-snippets there."
+ (interactive)
+ (if (equal (buffer-name) "*faith*")
+ ""
+ (progn
+ (get-buffer-create "*faith*")
+ (switch-to-buffer "*faith*")))
+ (let ((go-this-time t))
+ (while go-this-time
+ (goto-char (point-max))
+ (insert faith-quotes-separator (faith-quote))
+ (goto-char (point-max))
+ (recenter)
+ (setq fill-column faith-fill-column)
+ (call-interactively 'fill-paragraph)
+ (if (y-or-n-p "Care for more wise words? ")
+ nil
+ (setq go-this-time nil))))
+ (message "Use M-x faith-correct on your own documents in order to correct them."))
+
+;;;###autoload
+(defun faith-quote (&optional quotes leave-alone-p )
+ "Helps reinforce and spread faith in the ONE TRUE EDITOR.
+Returns a randomly chosen snippet, which helps you along your search
+for truth. If the argument QUOTES is supplied, it is the one used
+instead of using the default source for quotes. If LEAVE-ALONE-P is
+non-nil, then no faith-correction is done before insertion of the quote..
+"
+ (interactive)
+ (let* ((init-quote
+ (faith-false-choose
+ (if quotes quotes
+ (append faith-false-quotes faith-user-quotes))))
+ (final-quote
+ (if leave-alone-p
+ init-quote
+ (faith-correct-string init-quote)))
+ (justified-quote (faith-justify-string final-quote)))
+ (if (interactive-p)
+ (message justified-quote)
+ justified-quote)))
+
+;;;###autoload
+(defun faith-correct-buffer ()
+ "Replace false Gods by the ONE TRUE GOD.
+Takes a false SNIPPET, and weeds out the names of all false Gods and
+prophets."
+ (interactive)
+ ;; Now, for each from in each from-list, select a random to from to-list.
+ ;; to-list is called tos and from-list is called froms.
+ (let ((case-replace t)
+ (case-fold-search t))
+ (mapcar
+ (lambda (froms-tos)
+ (let ((tos (cadr froms-tos)))
+ (mapcar
+ (lambda (from)
+ (let ((this-to (nth (random* (length tos)) tos)))
+ (goto-char (point-min))
+ (while (re-search-forward (concat "\\b" from "")
+ nil t)
+ (replace-match this-to nil nil))))
+ (car froms-tos))))
+ (append faith-user-before-replacement-strings
+ faith-replacement-strings
+ faith-user-after-replacement-strings))
+ (buffer-substring (point-min) (point-max))))
+
+;;;###autoload
+(defun faith-correct-region (b e)
+ "Replace false Gods by the ONE TRUE GOD in region delimited by B and E."
+ (interactive "r")
+ (save-restriction
+ (save-excursion
+ (narrow-to-region b e)
+ (faith-correct-buffer)
+ (widen))))
+
+;;;###autoload
+(defun faith-correct-string (snippet)
+ "Replace false Gods by the ONE TRUE GOD.
+Takes a false SNIPPET, and weeds out the names of all false Gods and
+prophets."
+ (interactive)
+ (with-temp-buffer
+ (insert snippet)
+ (faith-correct-buffer)
+ (buffer-substring (point-min) (point-max))))
+
+(defun faith-false-choose (quotes)
+ "Return a randomly chosen WRONG snippet. THUS NOT FOR HUMAN EYES.
+Returns a randomly chosen false quote. Advice: Stay away.
+Argument QUOTES is a list of quotes."
+ (let* ((n (random* (length quotes)))
+ (s (nth n quotes)))
+ (if (stringp s) s
+ (error (format "The quote at postition %d is no string." n s)))))
+
+(defun faith-justify-string (string)
+ "Justifies it.."
+ (with-temp-buffer
+ (insert string)
+ (fill-paragraph 1)
+ (buffer-substring (point-min) (point-max)))
+)
+
+(unless faith-replacement-strings
+ (setq faith-replacement-strings
+ '(
+ (("allah" "buddha" "lord" "islam" "christianity" "hinduism") ("EMACS"))
+ (("almighty" "god") ("True Editor"))
+ (("adam" ) ("newbie"))
+ (("angel" ) ("truly free freebies"))
+ (("apostle") ( "book"))
+ (("bible" "koran") ("Emacs-manual"))
+ (("book") ("documentation"))
+ (("christ" ) ("emacs-homepage"))
+ (("christian" ) ("true follower"))
+ (("die" ) ("quit editland"))
+ (("gods") ("editors"))
+ (("earth" ) ("editland"))
+ (("heavens" ) ("elispland"))
+ (("holy spirit" ) ("holy editor"))
+ (("jesus" "muhammad" "muhammed" "mohammad" "mohammed")
+ ("gnu.org" "xemacs.org"))
+ (("mary") ("Gnus"))
+ (("Moses") ("Stallman" "RMS"))
+ (("the calf") ("vi"))
+ (("prophet") ("manual"))
+ (("religion") ("editing"))
+ (("satan") ("Microsoft" "Windoze" "VI"))
+ (("pray" ) ("edit"))
+ (("synagogue" "church") ("computer-room"))
+ )))
+
+
+(unless faith-false-quotes
+ (setq
+ faith-false-quotes
+ '("There shall be no compulsion in religion."
+
+ "This Book is not to be doubted. . . . As for the unbelievers, it is
+the same whether or not you forewarn them; they will not have faith.
+God has set a seal upon their hearts and ears; their sight is dimmed
+and grievous punishment awaits them."
+
+ "The only true faith in God's sight is EMACS."
+
+ "He that chooses a religion over Islam, it will not be accepted from
+him and in the world to come he will be one of the lost."
+
+ "It is not for true believers men or women to take their choice in the
+affairs if God and His apostle decree otherwise. He that disobeys God
+and His apostle strays far indeed."
+
+ "God's curse be upon the infidels! Evil is that for which they have
+bartered away their souls. To deny God's own revelation, grudging that
+He should reveal His bounty to whom He chooses from among His
+servants! They have incurred God's most inexorable wrath. An
+ignominious punishment awaits the unbelievers."
+
+ "Fight for the sake of God those that fight against you, but do not
+attack them first. God does not love the aggressors.
+
+Slay them wherever you find them. Drive them out of the places from
+which they drove you. Idolatry is worse than carnage."
+
+ "Prophet, make war on the unbelievers and the hypocrites and deal
+rigorously with them. Hell shall be their home: an evil fate."
+
+ "The Lord is my strength and song; he has become my salvation. He is my
+God, and I will praise him, my father's God, and I will exalt him."
+
+ "Love the Lord your God with all your heart and with all your soul and
+with all your strength."
+
+ "Therefore go and make disciples of all nations, baptizing them in the
+name of the Father and of the Son and the Holy Spirit, and teaching
+them to obey everything I have commanded you. And surely I will be
+with you always, to the very end of the age."
+
+ "Have faith in God, Jesus answered. Therefore I tell you, whatever you
+ask for in prayer, believe that you will receive it, and it will be
+yours."
+
+ "And Mary said: My soul praises the Lord and my spirit rejoices in God
+my Saviour, for he has been mindful of the humble state of his
+servant."
+
+ "Jesus answered, It is written: Worship the Lord your God and serve him
+only."
+
+ "When you are brought before synagogues, rulers and authorities, do not
+worry about how you will defend yourselves or what you will say, for
+the Holy Spirit will teach you at that time what you should say."
+
+ "Then Jesus cried out, When a man believes in me, he does not believe
+in me only, but in the one who sent me. I have come into the world as
+light, so that no one who believes in me should stay in darkness."
+
+ "Jesus said, I am the way and the truth and the life. No one comes to
+the Father except through me."
+
+ "...Count yourselves dead to sin but alive to God in Christ Jesus."
+
+ "May the God who gives endurance and encouragement give you a spirit of
+unity among yourselves as you follow Christ Jesus ,so that with one
+heart and mouth you may glorify the God and Father of our Lord Jesus
+Christ."
+
+ "May the God of hope fill you with great joy and peace as you trust in
+him, so that you may overflow with hope by the power of the Holy
+Spirit."
+
+ "...God's abundant provision of grace and of the gift of righteousness
+reign in life through the one and only , Jesus Christ."
+
+ "The mind of sinful man is death, but the mind controlled by the Spirit
+is life and peace, because the sinful mind is hostile to God. It does
+not submit to God's law, nor can it do so. Those controlled by their
+sinful nature cannot please God."
+
+ "...No eyes have seen, no ear has heard, no mind had conceived what God
+had prepared for those who love him but God had revealed it to us by his
+Spirit. The spirit searches all things, even the deep things of God. For who
+among men knows the thoughts of a man except the man's spirit within him? In
+the same way no one knows the thoughts of God except the Spirit of God."
+
+ "The Lord will rescue me from every evil attack and will bring me
+safely to his heavenly kingdom."
+
+ "For God did not give us a spirit of timidity, but a spirit of power,
+of love and of self-discipline."
+
+ "If you suffer as a Christian, do not be ashamed but praise God that
+you bear that name."
+
+ "Cast all your anxiety on Jesus because he cares for you."
+
+ "57:1 All that is in heaven and earth gives glory to Allah. He is
+the Mighty, the Wise One."
+
+ "His is the kingdom of the heavens and the earth. He ordains life
+and death and has power over all things."
+
+ "He created the heavens and the earth in six days and then mounted
+His throne. He knows all that goes into the earth and all that
+emerges from it, all that comes down from heaven and all that
+ascends to it. He is with you wherever you are. He is cognizant of
+all your actions."
+
+ "His is the kingdom of the heavens and the earth. To Him shall all
+things return. He causes the night to pass into the day and the day
+into the night. He has knowledge of the inmost thoughts of men."
+
+ "24:34 Allah is the light of the heavens and the earth. His light
+may be compared to a niche that enshrines a lamp, the lamp within a
+crystal of star-like brilliance. It is lit from a blessed olive
+tree neither eastern nor western. Its very oil would almost shine
+forth, though no fire touched it. Light upon light; Allah guides to
+His light whom He will."
+
+ "24:36 As for the unbelievers, their works are like a mirage in a
+desert. The thirsty traveler thinks it is water, but when he comes
+near he finds that it is nothing. He finds Allah there, who pays
+him back in full. Swift is Allah's reckoning."
+
+ "Or like darkness on a bottomless ocean spread with clashing billows
+and overcast with clouds: darkness upon darkness. If he stretches
+out his hand he can scarcely see it. Indeed the man from whom Allah
+withholds His light shall find no light at all."
+
+ "10:80 We are the witnesses of all your thoughts and all your
+prayers and all your actions. Not an atom's weight in earth or
+heaven escapes your Lord, nor is there any object smaller or
+greater, but is recorded in a glorious book."
+
+ "58:7 Are you not aware that Allah knows what the heavens and the
+earth contain? If three men talk in secret together, He is their
+fourth; if four, He is their fifth; if five, He is their sixth;
+whether fewer or more, wherever they be, He is with them. Then, on
+the Day of Resurrection, He will inform them of their doings. Allah
+has knowledge of all things."
+
+ "39:39 Allah takes away men's souls upon their death, and the souls
+of the living during their sleep. Those that are doomed He keeps
+with Him and restores the others for a time ordained. Surely there
+are signs in this for thinking men."
+
+ "35:11 Praise be to Allah, the Creator of heaven and earth! He sends
+forth the angels as His messengers, with two, three or four airs of
+wings. He Multiplies His creatures according to His will. Allah has
+power over all things."
+
+ "2:32 To Adam We said: \"Dwell with your wife in Paradise and eat of
+its fruits to your hearts' content wherever you will. But never
+approach this tree or you shall both become transgressors.\"
+
+But Satan made them fall from Paradise and brought about their
+banishment. \"Go hence,\" We said, \"and may your offspring be enemies
+to each other. The earth will for a while provide your sustenance
+and dwelling place.\"
+
+Then Adam received commandments from his Lord, and his Lord
+relented towards him. He is the Forgiving One, the Merciful."
+
+ "65:12 It is Allah who has created seven heavens, and earths as
+many. His commandment descends through them, so that you may know
+that Allah has power over all things, and that He has knowledge of
+all things."
+
+ "14:19 Do you not see that Allah has created the heavens and the
+earth with truth? He can destroy you if He wills and bring into
+being a new creation: that is no difficult thing for him."
+
+ "40:67 It was He who created you from dust, making you a little
+germ, and then a clot of blood. He brings you infants into the
+world; you reach manhood, then decline into old age (though some of
+you die young), so that you may complete your appointed term and
+grow in wisdom."
+
+ "16:75 To Allah belong the secrets of the heavens and the earth. The
+business of the Final Hour shall be accomplished in the twinkling
+of an eye, or even less. Allah has power over all things."
+
+ "2:86 To Moses We gave the Scriptures and after him we sent other
+apostles. We gave Jesus the son of Mary veritable signs and
+strengthened him with the Holy Spirit. Will you then scorn each
+apostle whose message does not suit your fancies, charging some
+with imposture and slaying others?"
+
+ "6:104 They solemnly swear by Allah that if a sign be given them
+they would believe in it. Say: \"Signs are vouchsafed by Allah.\" And
+how can you tell that if a sign be given them they will indeed
+believe in it?"
+
+ "We will turn away their hearts and eyes from the truth since they
+refused to believe in it at first. We will leave them to blunder
+about in their wrongdoing."
+
+ "If We sent down the angels and caused the dead to speak with them,
+and ranged all things before them, they would still not believe,
+Unless Allah willed it. But most of them are ignorant men."
+
+ "4:153 The People of the Book ask you to bring down for them a book
+from heaven. Of Moses they demanded a harder thing than that. They
+said to him: \"Show us Allah distinctly.\" And for their wickedness a
+thunderbolt smote them. They worshipped the calf after We revealed
+to them Our signs; yet We forgave them that, and bestowed on Moses
+clear authority."
+
+ "32:21 We gave the Scriptures to Moses (never doubt that you will
+meet him) and made it a guide for Israelites. And when they grew
+steadfast and firmly believed in Our revelations, We appointed
+leaders from among them who gave guidance at Our bidding. On the
+Day of Resurrection your Lord will resolve for them their
+differences."
+
+ "4:171 People of the Book, do not transgress the bounds of your
+religion. Speak nothing but the truth about Allah. The Messiah,
+Jesus the son of Mary, was no more than Allah's apostle and His
+Word which he cast to Mary: a spirit from Him. So believe in Allah
+and His apostles and do not say: \"Three;\" Forbear, and it shall be
+better for you. Allah is but one God. Allah forbid that He should
+have a son! His is all that the heavens and the earth contain.
+Allah is the all-sufficient Protector. The Messiah does not disdain
+to be a servant of Allah, nor do the angels who are nearer to him.
+Those who through arrogance disdain His service shall all be
+brought before Him."
+
+ "73:1 You that are wrapped up in your mantle, keep vigil all night,
+save for a few hours; half the night, or even less: or a little
+more - and with measured tone recite the Koran, for We are about to
+address to you words of surpassing gravity. It is in the watches of
+the night that impressions are strongest and words most eloquent;
+in the day-time you are hard-pressed with work.
+
+\(You need not move your tongue too fast to learn this revelation.
+We Ourself shall see to its collection and recital. When We read
+it, follow its words attentively; We shall Ourself explain its
+meaning.)"
+
+ "20:114 Do not be quick to recite the Koran before its revelation is
+completed, but rather say: \"Lord, increase my knowledge.\""
+
+ "42:48 Thus We have inspired you with a spirit of Our will when you
+knew nothing of faith or scripture, and made it a light whereby we
+guide those of Our servants whom We please. You shall surely guide
+them to the right path: the path of Allah, to whom belongs all that
+the heavens and the earth contain. All things in the end return to
+him."
+
+ "25:27 The unbelievers ask: \"Why was the Koran not revealed to him
+entire in a single revelation?\"
+
+We have revealed it thus so that We may strengthen your faith. We
+have imparted it to you by gradual revelation. No sooner will they
+come to you with an argument than We shall reveal to you the truth
+and properly explain it. Those who will be dragged headlong into
+Hell shall have an evil place to-dwell in, for they have strayed
+far from the right path."
+
+ "4:159 We have revealed Our will to you as We revealed it to Noah
+and to the prophets who came after him; as We revealed it to
+Abraham, Ishmael, Isaac, Jacob, and David, to whom We gave the
+Psalms. Of some apostles We have already told you (how Allah spoke
+directly to Moses); but there are others of whom We have not yet
+spoken: apostles who brought good news to mankind and admonished
+them, so that they might have no plea against Allah after their
+coming. Allah is mighty and wise."
+
+ "40:78 We have sent forth other apostles before you, of some you
+have already heard, of others We have told you nothing. Yet none of
+these could work a miracle except by Allah's leave. And when
+Allah's will is done, justice will prevail and those who have
+denied His signs will come to grief."
+
+ "16:40 The apostles We sent before you were no more than mortals
+whom We inspired with revelations and with writings. Ask the People
+of the Book, ii you doubt this. To you We have revealed the Koran,
+so that you may proclaim to men what has been revealed to them, and
+that they may give thought."
+
+ "13:38 We have sent forth other apostles before you and given them
+wives and children. Yet none of them could work miracles except by
+the will of Allah. Every age has its scripture. Allah confirms or
+abrogates what He pleases. His is the Eternal Book."
+
+ "22:46 Never have We sent a single prophet or apostle before you
+with whose wishes Satan did not tamper. But Allah abrogates the
+interjections of Satan and confirms His own revelations. Allah is
+wise and all-knowing. He makes Satan's interjections a temptation
+for those whose hearts are diseased or hardened - this is why the
+wrongdoers are in open schism - so that those to whom knowledge has
+been given may realize that this is the truth from your Lord and
+thus believe in it and humble their hearts towards him. Allah will
+surely guide the faithful to a straight path."
+
+ "36:68 We have taught Mohammed no poetry, nor does it become him to
+be a poet. This is but a warning: an eloquent Koran to admonish the
+living and No pass judgment on the unbelievers."
+
+ "29:48 Never have you read a book before this, nor have you ever
+transcribed one with your right hand. Had you done either of these,
+- the unbelievers might have justly doubted. But to those who are
+endowed with knowledge it is an undoubted sign. Only the wrongdoers
+deny Our signs."
+
+ "68:1 By the pen, and what they write, you are not mad: thanks to
+the favor of your Lord! A lasting recompense awaits you, for yours
+is a sublime nature. You shall before long see - as they will see -
+which of you is mad."
+
+ "39:22 Allah has now revealed the best of scriptures, a book uniform
+in style proclaiming promises and warnings. Those who fear their
+Lord are filled with awe as they listen to its revelations, so that
+their hearts soften at the remembrance of Allah. Such is Allah's
+guidance: He bestows it on whom He will. But he whom Allah misleads
+shall have none to guide him."
+
+ "Allah is the only GOD and Muhammad is HIS only prophet."
+ )))
+
+
+
+
+(provide 'faith)
+;;; faith.el ends here
diff --git a/custom/profile-dotemacs.el b/custom/profile-dotemacs.el
new file mode 100644
index 00000000..f16e8652
--- /dev/null
+++ b/custom/profile-dotemacs.el
@@ -0,0 +1,200 @@
+;;; profile-dotemacs.el --- Profile your Emacs init file
+
+;; Copyright (C) 2010, 2012 David Engster
+
+;; Author: David Engster <dengste@eml.cc>
+
+;; This file is NOT part of GNU Emacs.
+
+;; 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 2
+;; 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:
+
+;; This is to easily profile your Emacs init file (or any other
+;; script-like Emacs Lisp file, for that matter).
+
+;; It will go over all sexp's (balanced expressions) in the file and
+;; run them through `benchmark-run'. It will then show the file with
+;; overlays applied in a way that let you easily find out which sexp's
+;; take the most time. Since time is relative, it's not the absolute
+;; value that counts but the percentage of the total running time.
+;;
+;; * All other sexp's with a percentage greater than
+;; `profile-dotemacs-low-percentage' will be preceded by a
+;; highlighted line, showing the results from `benchmark-run'.
+;; Also, the more 'reddish' the background of the sexp, the more
+;; time it needs.
+
+;; * All other sexp's will be grayed out to indicate that their
+;; running time is miniscule. You can still see the benchmark
+;; results in the minibuffer by hovering over the sexp with the
+;; mouse.
+
+;; You can only benchmark full sexp's, so if you wrapped large parts
+;; of your init file in some conditional clause, you'll have to remove
+;; that for getting finer granularity.
+
+;;; Usage:
+
+;; Start emacs as follows:
+;;
+;; emacs -Q -l <PATH>/profile-dotemacs.el -f profile-dotemacs
+;;
+;; with <PATH> being the path to where this file resides.
+
+;;; Caveats (thanks to Raffaele Ricciardi for reporting those):
+
+;; - The usual `--debug-init' for debugging your init file won't work
+;; with profile-dotemacs, so you'll have to call
+;; `toggle-debug-on-error', either on the commandline or at the
+;; beginning of your init file.
+;; - `load-file-name' is nil when the init file is being loaded
+;; by the profiler. This might matter if you perform the
+;; bulk of initializations in a different file.
+;; - Starting external shells like IELM or eshell in your init file
+;; might mess with overlay creation, so this must not be done.
+
+;;; Download:
+
+;; You can always get the latest version from
+;; http://randomsample.de/profile-dotemacs.el
+
+;;; Code:
+
+(require 'thingatpt)
+(require 'benchmark)
+
+;; User variables
+
+(defvar profile-dotemacs-file "~/.emacs.d/init.el"
+ "File to be profiled.")
+
+(defvar profile-dotemacs-low-percentage 3
+ "Percentage which should be considered low.
+All sexp's with a running time below this percentage will be
+grayed out.")
+
+(defface profile-dotemacs-time-face
+ '((((background dark)) (:background "OrangeRed1"))
+ (t (:background "red3")))
+ "Background color to indicate percentage of total time.")
+
+(defface profile-dotemacs-low-percentage-face
+ '((((background dark)) (:foreground "gray25"))
+ (t (:foreground "gray75")))
+ "Face for sexps below `profile-dotemacs-low-percentage'.")
+
+(defface profile-dotemacs-highlight-face
+ '((((background dark)) (:background "blue"))
+ (t (:background "yellow")))
+ "Highlight face for benchmark results.")
+
+;; Main function
+
+(defun profile-dotemacs ()
+ "Load `profile-dotemacs-file' and benchmark its sexps."
+ (interactive)
+ (with-current-buffer (find-file-noselect profile-dotemacs-file t)
+ (setq buffer-read-only t) ;; just to be sure
+ (goto-char (point-min))
+ (let (start end results)
+ (while
+ (< (point)
+ (setq end (progn
+ (forward-sexp 1)
+ (point))))
+ (forward-sexp -1)
+ (setq start (point))
+ (add-to-list
+ 'results
+ `(,start ,end
+ ,(benchmark-run
+ (eval (sexp-at-point)))))
+ (goto-char end))
+ (profile-dotemacs-show-results results)
+ (switch-to-buffer (current-buffer)))))
+
+;; Helper functions
+
+(defun profile-dotemacs-show-results (results)
+ "Show timings from RESULTS in current buffer."
+ (let ((totaltime (profile-dotemacs-totaltime results))
+ current percentage ov)
+ (while results
+ (let* ((current (pop results))
+ (ov (make-overlay (car current) (cadr current)))
+ (current (car (last current)))
+ (percentage (/ (+ (car current) (nth 2 current))
+ totaltime))
+ col benchstr lowface)
+ (setq col
+ (profile-dotemacs-percentage-color
+ percentage
+ (face-background 'default)
+ (face-background 'profile-dotemacs-time-face)))
+ (setq percentage (round (* 100 percentage)))
+ (setq benchstr (profile-dotemacs-make-benchstr current))
+ (overlay-put ov 'help-echo benchstr)
+ (if (and (numberp profile-dotemacs-low-percentage)
+ (< percentage profile-dotemacs-low-percentage))
+ (overlay-put ov 'face 'profile-dotemacs-low-percentage-face)
+ (overlay-put ov 'before-string
+ (propertize benchstr
+ 'face 'profile-dotemacs-highlight-face))
+ (overlay-put ov 'face
+ `(:background ,col)))))
+ (setq ov (make-overlay (1- (point-max)) (point-max)))
+ (overlay-put ov 'after-string
+ (propertize
+ (format "\n-----------------\nTotal time: %.2fs\n"
+ totaltime)
+ 'face 'profile-dotemacs-highlight-face))))
+
+(defun profile-dotemacs-totaltime (results)
+ "Calculate total time of RESULTS."
+ (let ((totaltime 0))
+ (mapc (lambda (x)
+ (let ((cur (car (last x))))
+ (setq totaltime (+ totaltime (car cur) (nth 2 cur)))))
+ results)
+ totaltime))
+
+(defun profile-dotemacs-percentage-color (percent col-begin col-end)
+ "Calculate color according to PERCENT between COL-BEGIN and COL-END."
+ (let* ((col1 (color-values col-begin))
+ (col2 (color-values col-end))
+ (col
+ (mapcar (lambda (c)
+ (round
+ (+ (* (- 1 percent) (nth c col1))
+ (* percent (nth c col2)))))
+ '(0 1 2))))
+ (format "RGB:%04x/%04x/%04x"
+ (car col)
+ (nth 1 col)
+ (nth 2 col))))
+
+(defun profile-dotemacs-make-benchstr (timings)
+ "Create descriptive benchmark string from TIMINGS."
+ (format
+ (concat
+ "<Percentage: %d ; "
+ "Time: %.2f ; "
+ "Number of GC: %d ; "
+ "Time for GC: %.2f>\n")
+ percentage
+ (car timings) (nth 1 timings) (nth 2 timings)))
+
+
+;; profile-dotemacs.el ends here
diff --git a/custom/sdcv-mode.el b/custom/sdcv-mode.el
new file mode 100644
index 00000000..bdb89cd6
--- /dev/null
+++ b/custom/sdcv-mode.el
@@ -0,0 +1,414 @@
+;;; sdcv-mode.el --- major mode to do dictionary query through sdcv
+
+;; Copyright 2006~2008 pluskid,
+;; 2011 gucong
+;;
+;; Author: pluskid <pluskid@gmail.com>,
+;; gucong <gucong43216@gmail.com>
+;;
+;; 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 2, 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, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;; This is a major mode to view output of dictionary search of sdcv.
+
+;; Put this file into your load-path and the following into your
+;; ~/.emacs:
+;; (require 'sdcv-mode)
+;; (global-set-key (kbd "C-c d") 'sdcv-search)
+
+;;; Changelog:
+
+;; 2012/01/02
+;; * New variable: `sdcv-word-processor'
+;; * Breaking change:
+;; for `sdcv-dictionary-list' and `sdcv-dictionary-alist',
+;; non-list (non-nil) value now means full dictionary list
+;; * Rewrite `sdcv-search' for both interactive and non-interactive use
+;; * `sdcv-dictionary-list' is left for customization use only
+;; * Better highlighting.
+;;
+;; 2011/06/30
+;; * New feature: parse output for failed lookup
+;; * Keymap modification
+;;
+;; 2008/06/11
+;; * sdcv-mode v 0.1 init (with background process)
+
+;;; Code:
+
+(require 'outline)
+(provide 'sdcv-mode)
+(eval-when-compile
+ (require 'cl))
+
+;;; ==================================================================
+;;; Frontend, search word and display sdcv buffer
+(defun sdcv-search (word &optional dict-list-name dict-list interactive-p)
+ "Search WORD through the command-line tool sdcv.
+The result will be displayed in buffer named with
+`sdcv-buffer-name' with `sdcv-mode' if called interactively.
+
+When provided with DICT-LIST-NAME, query `sdcv-dictionary-alist'
+to get the new dictionary list before search.
+Alternatively, dictionary list can be specified directly
+by DICT-LIST. Any non-list value of it means using all dictionaries.
+
+When called interactively, prompt for the word.
+Prefix argument have the following meaning:
+If `sdcv-dictionary-alist' is defined,
+use prefix argument to select a new DICT-LIST-NAME.
+Otherwise, prefix argument means using all dictionaries.
+
+Word may contain some special characters:
+ * match zero or more characters
+ ? match zero or one character
+ / used at the beginning, for fuzzy search
+ | used at the beginning, for data search
+ \ escape the character right after"
+ (interactive
+ (let* ((dict-list-name
+ (and current-prefix-arg sdcv-dictionary-alist
+ (completing-read "Select dictionary list: "
+ sdcv-dictionary-alist nil t)))
+ (dict-list
+ (and current-prefix-arg (not sdcv-dictionary-alist)))
+ (guess (or (and transient-mark-mode mark-active
+ (buffer-substring-no-properties
+ (region-beginning) (region-end)))
+ (current-word nil t)))
+ (word (read-string (format "Search dict (default: %s): " guess)
+ nil nil guess)))
+ (list word dict-list-name dict-list t)))
+ ;; init current dictionary list
+ (when (null sdcv-current-dictionary-list)
+ (setq sdcv-current-dictionary-list sdcv-dictionary-list))
+ ;; dict-list-name to dict-list
+ (when (and (not dict-list) dict-list-name)
+ (if (not sdcv-dictionary-alist)
+ (error "`sdcv-dictionary-alist' not defined"))
+ (setq dict-list
+ (cdr (assoc dict-list-name sdcv-dictionary-alist))))
+ ;; prepare new dictionary list
+ (when (and dict-list (not (equal sdcv-current-dictionary-list dict-list)))
+ (setq sdcv-current-dictionary-list dict-list)
+ ;; kill sdcv process
+ (and (get-process sdcv-process-name)
+ (kill-process (get-process sdcv-process-name)))
+ (while (get-process sdcv-process-name)
+ (sleep-for 0.01)))
+ (let ((result
+ (concat ">>>"
+ (mapconcat
+ (lambda (w) (sdcv-do-lookup w))
+ (if sdcv-word-processor
+ (let ((processed (funcall sdcv-word-processor word)))
+ (if (listp processed) processed (list processed)))
+ (list word))
+ ">>>"))))
+ (if (not interactive-p)
+ result
+ (with-current-buffer (get-buffer-create sdcv-buffer-name)
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (insert result))
+ (sdcv-goto-sdcv)
+ (sdcv-mode)
+ (sdcv-mode-reinit))))
+
+(defun sdcv-list-dictionary ()
+ "Show available dictionaries."
+ (interactive)
+ (let (resize-mini-windows)
+ (shell-command "sdcv -l" sdcv-buffer-name)))
+
+(defvar sdcv-current-dictionary-list nil)
+
+(defun sdcv-generate-dictionary-argument ()
+ "Generate dictionary argument for sdcv from `sdcv-current-dictionary-list'
+and `sdcv-dictionary-path'."
+ (append
+ (and sdcv-dictionary-path (list "--data-dir" sdcv-dictionary-path))
+ (and (listp sdcv-current-dictionary-list)
+ (mapcan (lambda (dict)
+ (list "-u" dict))
+ sdcv-current-dictionary-list))))
+
+;;; ==================================================================
+;;; utilities to switch from and to sdcv buffer
+(defvar sdcv-previous-window-conf nil
+ "Window configuration before switching to sdcv buffer.")
+(defun sdcv-goto-sdcv ()
+ "Switch to sdcv buffer in other window."
+ (interactive)
+ (unless (eq (current-buffer)
+ (sdcv-get-buffer))
+ (setq sdcv-previous-window-conf (current-window-configuration)))
+ (let* ((buffer (sdcv-get-buffer))
+ (window (get-buffer-window buffer)))
+ (if (null window)
+ (switch-to-buffer-other-window buffer)
+ (select-window window))))
+(defun sdcv-return-from-sdcv ()
+ "Bury sdcv buffer and restore the previous window configuration."
+ (interactive)
+ (if (window-configuration-p sdcv-previous-window-conf)
+ (progn
+ (set-window-configuration sdcv-previous-window-conf)
+ (setq sdcv-previous-window-conf nil)
+ (bury-buffer (sdcv-get-buffer)))
+ (bury-buffer)))
+
+(defun sdcv-get-buffer ()
+ "Get the sdcv buffer. Create one if there's none."
+ (let ((buffer (get-buffer-create sdcv-buffer-name)))
+ (with-current-buffer buffer
+ (unless (eq major-mode 'sdcv-mode)
+ (sdcv-mode)))
+ buffer))
+
+;;; ==================================================================
+;;; The very major mode
+(defvar sdcv-mode-font-lock-keywords
+ '(
+ ;; dictionary name
+ ("^-->\\(.*\\)$" . (1 sdcv-hit-face))
+ ("^==>\\(.*\\)$" . (1 sdcv-failed-face))
+ ("^\\(>>>.*\\)$" . (1 sdcv-heading-face))
+ )
+ "Expressions to hilight in `sdcv-mode'")
+
+(defvar sdcv-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "q" 'sdcv-return-from-sdcv)
+ (define-key map (kbd "RET") 'sdcv-search)
+ (define-key map "a" 'show-all)
+ (define-key map "h" 'hide-body)
+ (define-key map "o" 'sdcv-toggle-entry)
+ (define-key map "n" 'sdcv-next-entry)
+ (define-key map "p" 'sdcv-previous-entry)
+ map)
+ "Keymap for `sdcv-mode'.")
+
+(define-derived-mode sdcv-mode nil "sdcv"
+ "Major mode to look up word through sdcv.
+\\{sdcv-mode-map}
+Turning on Text mode runs the normal hook `sdcv-mode-hook'."
+ (setq font-lock-defaults '(sdcv-mode-font-lock-keywords))
+ (setq buffer-read-only t)
+ (set (make-local-variable 'outline-regexp) "-->.*\n-->\\|==>\\|>>>")
+ (set (make-local-variable font-lock-string-face) nil)
+)
+
+(defun sdcv-mode-reinit ()
+ "Re-initialize buffer.
+Hide all entrys but the first one and goto
+the beginning of the buffer."
+ (ignore-errors
+ (setq buffer-read-only nil)
+ (sdcv-parse-failed)
+ (setq buffer-read-only t)
+ (hide-body)
+ (goto-char (point-min))
+ (forward-line 1)
+ (show-entry)))
+
+(defun sdcv-parse-failed ()
+ (goto-char (point-min))
+ (let (save-word)
+ (while (re-search-forward "^[0-9]+).*-->\\(.*\\)$" nil t)
+ (let ((cur-word (match-string-no-properties 1)))
+ (unless (string= save-word cur-word)
+ (setq save-word cur-word)
+ (re-search-backward "^\\(.\\)" nil t)
+ (match-string 1)
+ (insert (format "\n==>%s\n" save-word)))))))
+
+(defun sdcv-next-entry ()
+ (interactive)
+ (outline-next-heading)
+ (show-entry)
+ (recenter-top-bottom 0))
+(defun sdcv-previous-entry ()
+ (interactive)
+ (outline-previous-heading)
+ (show-entry)
+ (recenter-top-bottom 0))
+
+(defun sdcv-toggle-entry ()
+ (interactive)
+ (save-excursion
+ (outline-back-to-heading)
+ (if (not (outline-invisible-p (line-end-position)))
+ (hide-entry)
+ (show-entry))))
+
+;;; ==================================================================
+;;; Support for sdcv process in background
+(defun sdcv-do-lookup (word)
+ "Send the word to the sdcv process and return the result."
+ (let ((process (sdcv-get-process)))
+ (process-send-string process (concat word "\n"))
+ (with-current-buffer (process-buffer process)
+ (let ((i 0) rlt done)
+ (while (and (not done)
+ (< i sdcv-wait-timeout))
+ (when (sdcv-match-tail sdcv-word-prompts)
+ (setq rlt (buffer-substring-no-properties (point-min)
+ (point-max)))
+ (setq done t))
+ (when (sdcv-match-tail sdcv-choice-prompts)
+ (process-send-string process "-1\n"))
+ (unless done
+ (sleep-for sdcv-wait-interval)
+ (setq i (+ i sdcv-wait-interval))))
+ (unless (< i sdcv-wait-timeout)
+ ;; timeout
+ (kill-process process)
+ (error "ERROR: timeout waiting for sdcv"))
+ (erase-buffer)
+ rlt))))
+
+(defvar sdcv-wait-timeout 2
+ "The max time (in seconds) to wait for the sdcv process to
+produce some output.")
+(defvar sdcv-wait-interval 0.01
+ "The interval (in seconds) to sleep each time to wait for
+sdcv's output.")
+
+(defconst sdcv-process-name "%sdcv-mode-process%")
+(defconst sdcv-process-buffer-name "*sdcv-mode-process*")
+
+(defvar sdcv-word-prompts '("Enter word or phrase: "
+ "请输入单词或短语:"
+ "請輸入單字或片語:")
+ "A list of prompts that sdcv use to prompt for word.")
+
+(defvar sdcv-choice-prompts '("Your choice[-1 to abort]: "
+ "您的选择为:"
+ "您的選擇為:")
+ "A list of prompts that sdcv use to prompt for a choice
+of multiple candicates.")
+
+(defvar sdcv-result-patterns '("^Found [0-9]+ items, similar to [*?/|]*\\(.+?\\)[*?]*\\."
+ "^发现 [0-9]+ 条记录和 [*?/|]*\\(.+?\\)[*?]* 相似。"
+ )
+ "A list of patterns to extract result word of sdcv. Special
+characters are stripped.")
+
+(defun sdcv-get-process ()
+ "Get or create the sdcv process."
+ (let ((process (get-process sdcv-process-name)))
+ (when (null process)
+ (with-current-buffer (get-buffer-create
+ sdcv-process-buffer-name)
+ (erase-buffer)
+ (setq process (apply 'start-process
+ sdcv-process-name
+ sdcv-process-buffer-name
+ sdcv-program-path
+ (sdcv-generate-dictionary-argument)))
+ ;; kill the initial prompt
+ (let ((i 0))
+ (message "starting sdcv...")
+ (while (and (not (sdcv-match-tail sdcv-word-prompts))
+ (< i sdcv-wait-timeout))
+ (sleep-for sdcv-wait-interval)
+ (setq i (+ i sdcv-wait-interval)))
+ (unless (< i sdcv-wait-timeout)
+ ;; timeout
+ (kill-process process)
+ (error "ERROR: timeout waiting for sdcv"))
+ (erase-buffer))))
+ process))
+
+(defun sdcv-buffer-tail (length)
+ "Get a substring of length LENGTH at the end of
+current buffer."
+ (let ((beg (- (point-max) length))
+ (end (point-max)))
+ (if (< beg (point-min))
+ (setq beg (point-min)))
+ (buffer-substring-no-properties beg end)))
+
+(defun sdcv-match-tail (prompts)
+ (let ((done nil)
+ (prompt nil))
+ (while (and (not done)
+ prompts)
+ (setq prompt (car prompts))
+ (setq prompts (cdr prompts))
+ (when (string-equal prompt
+ (sdcv-buffer-tail (length prompt)))
+ (delete-region (- (point-max) (length prompt))
+ (point-max))
+ (setq done t)))
+ done))
+
+
+;;;;##################################################################
+;;;; User Options, Variables
+;;;;##################################################################
+
+(defvar sdcv-buffer-name "*sdcv*"
+ "The name of the buffer of sdcv.")
+(defvar sdcv-dictionary-list t
+ "A list of dictionaries to use.
+Each entry is a string denoting the name of a dictionary, which
+is then passed to sdcv through the '-u' command line option.
+Any non-list value means using all the dictionaries.")
+(defvar sdcv-dictionary-alist nil
+ "An alist of dictionaries, used to interactively form
+dictionary list. It has the form:
+ ((\"full\" . t)
+ (\"group1\" \"dict1\" \"dict2\" ...)
+ (\"group2\" \"dict2\" \"dict3\"))
+Any cons cell here means using all dictionaries.
+")
+
+(defvar sdcv-program-path "sdcv"
+ "The path of sdcv program.")
+
+(defvar sdcv-dictionary-path nil
+ "The path of dictionaries.")
+
+(defvar sdcv-word-processor nil
+ "This is the function that take a word (stirng)
+and return a word or a list of words for lookup by `sdcv-search'.
+All lookup result(s) will finally be concatenated together.
+
+`nil' value means do nothing with the original word.
+
+The following is an example. This function takes the original word and
+compare whether simplified and traditional form of the word are the same.
+If not, look up both of the words.
+
+ (lambda (word)
+ (let ((sim (chinese-conv word \"simplified\"))
+ (tra (chinese-conv word \"traditional\")))
+ (if (not (string= sim tra))
+ (list sim tra)
+ word)))
+")
+
+(defvar sdcv-hit-face 'font-lock-type-face
+ "Face for search hits")
+(defvar sdcv-failed-face 'font-lock-keyword-face
+ "Face for suggestions for a failed lookup.")
+(defvar sdcv-heading-face 'highlight
+ "Face for heading of lookup")
+
+(provide 'sdcv-mode)
+;;; sdcv-mode.el ends here