Skip to content
Browse files

Stuff

  • Loading branch information...
1 parent 83da537 commit 94ba16f2ffd9c9d2e39037873ada12f27d6318fd @srstrong committed
Showing with 3,982 additions and 91 deletions.
  1. +1,082 −0 ace-jump-mode.el
  2. +1,050 −0 browse-kill-ring.el
  3. +52 −17 dot_emacs
  4. +2 −1 erlang/erlang-flymake.el
  5. +1,267 −0 erlang/erlang-skels-old.el
  6. +271 −73 erlang/erlang.el
  7. +1 −0 expand-region.el
  8. +257 −0 handlebars-mode.el
View
1,082 ace-jump-mode.el
@@ -0,0 +1,1082 @@
+;;; ace-jump-mode.el --- a quick cursor location minor mode for emacs -*- coding: utf-8-unix -*-
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author : winterTTr <winterTTr@gmail.com>
+;; URL : https://github.com/winterTTr/ace-jump-mode/
+;; Version : 2.0.RC
+;; Keywords : motion, location, cursor
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; INTRODUCTION
+;;
+
+;; What's this?
+;;
+;; It is a minor mode for Emacs. It can help you to move your cursor
+;; to ANY position in emacs by using only 3 times key press.
+
+;; Where does ace jump mode come from ?
+;;
+;; I firstly see such kind of moving style is in a vim plugin called
+;; EasyMotion. It really attract me a lot. So I decide to write
+;; one for Emacs and MAKE IT BETTER.
+;;
+;; So I want to thank to :
+;; Bartlomiej P. for his PreciseJump
+;; Kim Silkebækken for his EasyMotion
+
+
+;; What's ace-jump-mode ?
+;;
+;; ace-jump-mode is an fast/direct cursor location minor mode. It will
+;; create the N-Branch search tree internal and marks all the possible
+;; position with predefined keys in within the whole emacs view.
+;; Allowing you to move to the character/word/line almost directly.
+;;
+
+;;; Usage
+;;
+;; Add the following code to your init file, of course you can select
+;; the key that you prefer to.
+;; ----------------------------------------------------------
+;; ;;
+;; ;; ace jump mode major function
+;; ;;
+;; (add-to-list 'load-path "/full/path/where/ace-jump-mode.el/in/")
+;; (autoload
+;; 'ace-jump-mode
+;; "ace-jump-mode"
+;; "Emacs quick move minor mode"
+;; t)
+;; ;; you can select the key you prefer to
+;; (define-key global-map (kbd "C-c SPC") 'ace-jump-mode)
+;;
+;; ;;
+;; ;; enable a more powerful jump back function from ace jump mode
+;; ;;
+;; (autoload
+;; 'ace-jump-mode-pop-mark
+;; "ace-jump-mode"
+;; "Ace jump back:-)"
+;; t)
+;; (eval-after-load "ace-jump-mode"
+;; '(ace-jump-mode-enable-mark-sync))
+;; (define-key global-map (kbd "C-x SPC") 'ace-jump-mode-pop-mark)
+;;
+;; ;;If you use viper mode :
+;; (define-key viper-vi-global-user-map (kbd "SPC") 'ace-jump-mode)
+;; ;;If you use evil
+;; (define-key evil-normal-state-map (kbd "SPC") 'ace-jump-mode)
+;; ----------------------------------------------------------
+
+;;; For more information
+;; Intro Doc: https://github.com/winterTTr/ace-jump-mode/wiki
+;; FAQ : https://github.com/winterTTr/ace-jump-mode/wiki/AceJump-FAQ
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+
+;;;; ============================================
+;;;; Utilities for ace-jump-mode
+;;;; ============================================
+
+;; ---------------------
+;; aj-position
+;; ---------------------
+
+;; make a position in a visual area
+(defstruct aj-position offset visual-area)
+
+(defmacro aj-position-buffer (aj-pos)
+ "Get the buffer object from `aj-position'."
+ `(aj-visual-area-buffer (aj-position-visual-area ,aj-pos)))
+
+(defmacro aj-position-window (aj-pos)
+ "Get the window object from `aj-position'."
+ `(aj-visual-area-window (aj-position-visual-area ,aj-pos)))
+
+(defmacro aj-position-frame (aj-pos)
+ "Get the frame object from `aj-position'."
+ `(aj-visual-area-frame (aj-position-visual-area ,aj-pos)))
+
+(defmacro aj-position-recover-buffer (aj-pos)
+ "Get the recover-buffer object from `aj-position'."
+ `(aj-visual-area-recover-buffer (aj-position-visual-area ,aj-pos)))
+
+
+
+;; ---------------------
+;; aj-visual-area
+;; ---------------------
+
+;; a record for all the possible visual area
+;; a visual area is a window that showing some buffer in some frame.
+(defstruct aj-visual-area buffer window frame recover-buffer)
+
+
+;; ---------------------
+;; a FIFO queue implementation
+;; ---------------------
+(defstruct aj-queue head tail)
+
+(defun aj-queue-push (item q)
+ "enqueue"
+ (let ( (head (aj-queue-head q) )
+ (tail (aj-queue-tail q) )
+ (c (list item) ) )
+ (cond
+ ((null (aj-queue-head q))
+ (setf (aj-queue-head q) c)
+ (setf (aj-queue-tail q) c))
+ (t
+ (setf (cdr (aj-queue-tail q)) c)
+ (setf (aj-queue-tail q) c)))))
+
+(defun aj-queue-pop (q)
+ "dequeue"
+ (if (null (aj-queue-head q))
+ (error "[AceJump] Interal Error: Empty queue"))
+
+ (let ((ret (aj-queue-head q)))
+ (if (eq ret (aj-queue-tail q))
+ ;; only one item left
+ (progn
+ (setf (aj-queue-head q) nil)
+ (setf (aj-queue-tail q) nil))
+ ;; multi item left, move forward the head
+ (setf (aj-queue-head q) (cdr ret)))
+ (car ret)))
+
+
+
+;;; main code start here
+
+;; register as a minor mode
+(or (assq 'ace-jump-mode minor-mode-alist)
+ (nconc minor-mode-alist
+ (list '(ace-jump-mode ace-jump-mode))))
+
+;; custoize variable
+(defvar ace-jump-word-mode-use-query-char t
+ "If we need to ask for the query char before enter `ace-jump-word-mode'")
+
+(defvar ace-jump-mode-case-fold case-fold-search
+ "If non-nil, the ace-jump mode will ignore case.
+
+The default value is set to the same as `case-fold-search'.")
+
+(defvar ace-jump-mode-mark-ring nil
+ "The list that is used to store the history for jump back.")
+
+(defvar ace-jump-mode-mark-ring-max 100
+ "The max length of `ace-jump-mode-mark-ring'")
+
+
+(defvar ace-jump-mode-gray-background t
+ "By default, when there is more than one candidate, the ace
+jump mode will gray the background and then mark the possible
+candidate position. Set this to nil means do not gray
+background.")
+
+(defvar ace-jump-mode-scope 'global
+ "Define what is the scope that ace-jump-mode works.
+
+Now, there three kind of values for this:
+1. 'global : ace jump can work across any window and frame, this is also the default.
+2. 'frame : ace jump will work for the all windows in current frame.
+3. 'window : ace jump will only work on current window only.
+ This is the same behavior for 1.0 version.")
+
+(defvar ace-jump-mode-detect-punc t
+ "When this is non-nil, the ace jump word mode will detect the
+char that is not alpha or number. Then, if the query char is a
+printable punctuaction, we will use char mode to start the ace
+jump mode. If it is nil, an error will come up when
+non-alpha-number is given under word mode.")
+
+
+(defvar ace-jump-mode-submode-list
+ '(ace-jump-word-mode
+ ace-jump-char-mode
+ ace-jump-line-mode)
+ "*The mode list when start ace jump mode.
+The sequence is the calling sequence when give prefix argument.
+
+Such as:
+ If you use the default sequence, which is
+ '(ace-jump-word-mode
+ ace-jump-char-mode
+ ace-jump-line-mode)
+and using key to start up ace jump mode, such as 'C-c SPC',
+then the usage to start each mode is as below:
+
+ C-c SPC ==> ace-jump-word-mode
+ C-u C-c SPC ==> ace-jump-char-mode
+ C-u C-u C-c SPC ==> ace-jump-line-mode
+
+Currently, the valid submode is:
+ `ace-jump-word-mode'
+ `ace-jump-char-mode'
+ `ace-jump-line-mode'
+
+")
+
+(defvar ace-jump-mode-move-keys
+ (nconc (loop for i from ?a to ?z collect i)
+ (loop for i from ?A to ?Z collect i))
+ "*The keys that used to move when enter AceJump mode.
+Each key should only an printable character, whose name will
+fill each possible location.
+
+If you want your own moving keys, you can custom that as follow,
+for example, you only want to use lower case character:
+\(setq ace-jump-mode-move-keys (loop for i from ?a to ?z collect i)) ")
+
+
+;;; some internal variable for ace jump
+(defvar ace-jump-mode nil
+ "AceJump minor mode.")
+(defvar ace-jump-background-overlay-list nil
+ "Background overlay which will grey all the display.")
+(defvar ace-jump-search-tree nil
+ "N-branch Search tree. Every leaf node holds the overlay that
+is used to highlight the target positions.")
+(defvar ace-jump-query-char nil
+ "Save the query char used between internal mode.")
+(defvar ace-jump-current-mode nil
+ "Save the current mode.
+See `ace-jump-mode-submode-list' for possible value.")
+
+(defvar ace-jump-recover-visual-area-list nil
+ "Save the ace jump aj-visual-area structure list.
+
+Sometimes, the different window may display the same buffer. For
+this case, we need to create a indirect buffer for them to make
+ace jump overlay can work across the differnt window with the
+same buffer. When ace jump ends, we need to recover the window to
+its original buffer.")
+(defvar ace-jump-sync-emacs-mark-ring nil
+ "When this variable is not-nil, everytime `ace-jump-mode-pop-mark' is called,
+ace jump will try to remove the same mark from buffer local mark
+ring and global-mark-ring, which help you to sync the mark
+information between emacs and ace jump.
+
+Note, never try to set this variable manually, this is for ace
+jump internal use. If you want to change it, use
+`ace-jump-mode-enable-mark-sync' or
+`ace-jump-mode-disable-mark-sync'.")
+
+(defgroup ace-jump nil
+ "ace jump group"
+ :group 'convenience)
+
+;;; define the face
+(defface ace-jump-face-background
+ '((t (:foreground "gray40")))
+ "Face for background of AceJump motion"
+ :group 'ace-jump)
+
+
+(defface ace-jump-face-foreground
+ '((((class color)) (:foreground "red"))
+ (((background dark)) (:foreground "gray100"))
+ (((background light)) (:foreground "gray0"))
+ (t (:foreground "gray100")))
+ "Face for foreground of AceJump motion"
+ :group 'ace-jump)
+
+
+(defvar ace-jump-mode-before-jump-hook nil
+ "Function(s) to call just before moving the cursor to a selected match")
+
+(defvar ace-jump-mode-end-hook nil
+ "Function(s) to call when ace-jump-mode is going to end up")
+
+(defvar ace-jump-allow-invisible nil
+ "Control if ace-jump should select the invisible char as candidate.
+Normally, the ace jump mark cannot be seen if the target character is invisible.
+So default to be nil, which will not include those invisible character as candidate.")
+
+
+(defun ace-jump-char-category ( query-char )
+ "Detect the type of the char.
+For the ascii table, refer to http://www.asciitable.com/
+
+There is four possible return value:
+1. 'digit: the number character
+2. 'alpha: A-Z and a-z
+3. 'punc : all the printable punctuaiton
+4. 'other: all the others"
+ (cond
+ ;; digit
+ ((and (>= query-char #x30) (<= query-char #x39))
+ 'digit)
+ ((or
+ ;; capital letter
+ (and (>= query-char #x41) (<= query-char #x5A))
+ ;; lowercase letter
+ (and (>= query-char #x61) (<= query-char #x7A)))
+ 'alpha)
+ ((or
+ ;; tab
+ (equal query-char #x9)
+ ;; punc before digit
+ (and (>= query-char #x20) (<= query-char #x2F))
+ ;; punc after digit before capital letter
+ (and (>= query-char #x3A) (<= query-char #x40))
+ ;; punc after capital letter before lowercase letter
+ (and (>= query-char #x5B) (<= query-char #x60))
+ ;; punc after lowercase letter
+ (and (>= query-char #x7B) (<= query-char #x7E)))
+ 'punc)
+ (t
+ 'other)))
+
+
+(defun ace-jump-search-candidate (re-query-string visual-area-list)
+ "Search the RE-QUERY-STRING in current view, and return the candidate position list.
+RE-QUERY-STRING should be an valid regex used for `search-forward-regexp'.
+
+You can control whether use the case sensitive or not by `ace-jump-mode-case-fold'.
+
+Every possible `match-beginning' will be collected.
+The returned value is a list of `aj-position' record."
+ (loop for va in visual-area-list
+ append (let* ((current-window (aj-visual-area-window va))
+ (start-point (window-start current-window))
+ (end-point (window-end current-window t)))
+ (with-selected-window current-window
+ (save-excursion
+ (goto-char start-point)
+ (let ((case-fold-search ace-jump-mode-case-fold))
+ (loop while (re-search-forward re-query-string nil t)
+ until (or
+ (> (point) end-point)
+ (eobp))
+ if (or ace-jump-allow-invisible (not (invisible-p (match-beginning 0))))
+ collect (make-aj-position :offset (match-beginning 0)
+ :visual-area va)
+ ;; when we use "^" to search line mode,
+ ;; re-search-backward will not move one
+ ;; char after search success, as line
+ ;; begin is not a valid visible char.
+ ;; We need to help it to move forward.
+ do (if (string-equal re-query-string "^")
+ (goto-char (1+ (match-beginning 0)))))))))))
+
+(defun ace-jump-tree-breadth-first-construct (total-leaf-node max-child-node)
+ "Constrct the search tree, each item in the tree is a cons cell.
+The (car tree-node) is the type, which should be only 'branch or 'leaf.
+The (cdr tree-node) is data stored in a leaf when type is 'leaf,
+while a child node list when type is 'branch"
+ (let ((left-leaf-node (- total-leaf-node 1))
+ (q (make-aj-queue))
+ (node nil)
+ (root (cons 'leaf nil)) )
+ ;; we push the node into queue and make candidate-sum -1, so
+ ;; create the start condition for the while loop
+ (aj-queue-push root q)
+ (while (> left-leaf-node 0)
+ (setq node (aj-queue-pop q))
+ ;; when a node is picked up from stack, it will be changed to a
+ ;; branch node, we lose a leaft node
+ (setf (car node) 'branch)
+ ;; so we need to add the sum of leaf nodes that we wish to create
+ (setq left-leaf-node (1+ left-leaf-node))
+ (if (<= left-leaf-node max-child-node)
+ ;; current child can fill the left leaf
+ (progn
+ (setf (cdr node)
+ (loop for i from 1 to left-leaf-node
+ collect (cons 'leaf nil)))
+ ;; so this should be the last action for while
+ (setq left-leaf-node 0))
+ ;; the child can not cover the left leaf
+ (progn
+ ;; fill as much as possible. Push them to queue, so it have
+ ;; the oppotunity to become 'branch node if necessary
+ (setf (cdr node)
+ (loop for i from 1 to max-child-node
+ collect (let ((n (cons 'leaf nil)))
+ (aj-queue-push n q)
+ n)))
+ (setq left-leaf-node (- left-leaf-node max-child-node)))))
+ ;; return the root node
+ root))
+
+(defun ace-jump-tree-preorder-traverse (tree &optional leaf-func branch-func)
+ "we move over tree via preorder, and call BRANCH-FUNC on each branch
+node and call LEAF-FUNC on each leaf node"
+ ;; use stack to do preorder traverse
+ (let ((s (list tree)))
+ (while (not (null s))
+ ;; pick up one from stack
+ (let ((node (car s)))
+ ;; update stack
+ (setq s (cdr s))
+ (cond
+ ((eq (car node) 'branch)
+ ;; a branch node
+ (when branch-func
+ (funcall branch-func node))
+ ;; push all child node into stack
+ (setq s (append (cdr node) s)))
+ ((eq (car node) 'leaf)
+ (when leaf-func
+ (funcall leaf-func node)))
+ (t
+ (message "[AceJump] Internal Error: invalid tree node type")))))))
+
+
+(defun ace-jump-populate-overlay-to-search-tree (tree candidate-list)
+ "Populate the overlay to search tree, every leaf will give one overlay"
+
+ (lexical-let* (;; create the locally dynamic variable for the following function
+ (position-list candidate-list)
+
+ ;; make the function to create overlay for each leaf node,
+ ;; here we only create each overlay for each candidate
+ ;; position, , but leave the 'display property to be empty,
+ ;; which will be fill in "update-overlay" function
+ (func-create-overlay (lambda (node)
+ (let* ((p (car position-list))
+ (offset (aj-position-offset p))
+ (va (aj-position-visual-area p))
+ (w (aj-visual-area-window va))
+ (b (aj-visual-area-buffer va))
+ ;; create one char overlay
+ (ol (make-overlay offset (1+ offset) b)))
+ ;; update leaf node to remember the ol
+ (setf (cdr node) ol)
+ (overlay-put ol 'face 'ace-jump-face-foreground)
+ ;; associate the aj-position data with overlay
+ ;; so that we can use it to do the final jump
+ (overlay-put ol 'aj-data p)
+ ;; next candidate node
+ (setq position-list (cdr position-list))))))
+ (ace-jump-tree-preorder-traverse tree func-create-overlay)
+ tree))
+
+
+(defun ace-jump-delete-overlay-in-search-tree (tree)
+ "Delete all the overlay in search tree leaf node"
+ (let ((func-delete-overlay (lambda (node)
+ (delete-overlay (cdr node))
+ (setf (cdr node) nil))))
+ (ace-jump-tree-preorder-traverse tree func-delete-overlay)))
+
+(defun ace-jump-buffer-substring (pos)
+ "Get the char under the POS, which is aj-position structure."
+ (let* ((w (aj-position-window pos))
+ (offset (aj-position-offset pos)))
+ (with-selected-window w
+ (buffer-substring offset (1+ offset)))))
+
+(defun ace-jump-update-overlay-in-search-tree (tree keys)
+ "Update overlay 'display property using each name in keys"
+ (lexical-let* (;; create dynamic variable for following function
+ (key ?\0)
+ ;; populdate each leaf node to be the specific key,
+ ;; this only update 'display' property of overlay,
+ ;; so that user can see the key from screen and select
+ (func-update-overlay
+ (lambda (node)
+ (let ((ol (cdr node)))
+ (overlay-put
+ ol
+ 'display
+ (concat (make-string 1 key)
+ (let* ((pos (overlay-get ol 'aj-data))
+ (subs (ace-jump-buffer-substring pos)))
+ (cond
+ ;; when tab, we use more space to prevent screen
+ ;; from messing up
+ ((string-equal subs "\t")
+ (make-string (1- tab-width) ? ))
+ ;; when enter, we need to add one more enter
+ ;; to make the screen not change
+ ((string-equal subs "\n")
+ "\n")
+ (t
+ "")))))))))
+ (loop for k in keys
+ for n in (cdr tree)
+ do (progn
+ ;; update "key" variable so that the function can use
+ ;; the correct context
+ (setq key k)
+ (if (eq (car n) 'branch)
+ (ace-jump-tree-preorder-traverse n
+ func-update-overlay)
+ (funcall func-update-overlay n))))))
+
+
+
+(defun ace-jump-list-visual-area()
+ "Based on `ace-jump-mode-scope', search the possible buffers that is showing now."
+ (cond
+ ((eq ace-jump-mode-scope 'global)
+ (loop for f in (frame-list)
+ append (loop for w in (window-list f)
+ collect (make-aj-visual-area :buffer (window-buffer w)
+ :window w
+ :frame f))))
+ ((eq ace-jump-mode-scope 'frame)
+ (loop for w in (window-list (selected-frame))
+ collect (make-aj-visual-area :buffer (window-buffer w)
+ :window w
+ :frame (selected-frame))))
+ ((eq ace-jump-mode-scope 'window)
+ (list
+ (make-aj-visual-area :buffer (current-buffer)
+ :window (selected-window)
+ :frame (selected-frame))))
+ (t
+ (error "[AceJump] Invalid ace-jump-mode-scope, please check your configuration"))))
+
+
+(defun ace-jump-mode-make-indirect-buffer (visual-area-list)
+ "When the differnt window show the same buffer. The overlay
+cannot work for same buffer at the same time. So the indirect
+buffer need to create to make overlay can work correctly.
+
+VISUAL-AREA-LIST is aj-visual-area list. This function will
+return the structure list for those make a indirect buffer.
+
+Side affect: All the created indirect buffer will show in its
+relevant window."
+ (loop for va in visual-area-list
+ ;; check if the current visual-area (va) has the same buffer with
+ ;; the previous ones (vai)
+ if (loop for vai in visual-area-list
+ ;; stop at itself, don't need to find the ones behind it (va)
+ until (eq vai va)
+ ;; if the buffer is same, return those(vai) before
+ ;; it(va) so that we know the some visual area has
+ ;; the same buffer with current one (va)
+ if (eq (aj-visual-area-buffer va)
+ (aj-visual-area-buffer vai))
+ collect vai)
+ ;; if indeed the same one find, we need create an indirect buffer
+ ;; to current visual area(va)
+ collect (with-selected-window (aj-visual-area-window va)
+ ;; store the orignal buffer
+ (setf (aj-visual-area-recover-buffer va)
+ (aj-visual-area-buffer va))
+ ;; create indirect buffer to use as working buffer
+ (setf (aj-visual-area-buffer va)
+ (clone-indirect-buffer nil nil))
+ ;; update window to the indirect buffer
+ (let ((ws (window-start)))
+ (set-window-buffer (aj-visual-area-window va)
+ (aj-visual-area-buffer va))
+ (set-window-start
+ (aj-visual-area-window va)
+ ws))
+ va)))
+
+
+(defun ace-jump-do( re-query-string )
+ "The main function to start the AceJump mode.
+QUERY-STRING should be a valid regexp string, which finally pass to `search-forward-regexp'.
+
+You can constrol whether use the case sensitive via `ace-jump-mode-case-fold'.
+"
+ ;; we check the move key to make it valid, cause it can be customized by user
+ (if (or (null ace-jump-mode-move-keys)
+ (< (length ace-jump-mode-move-keys) 2)
+ (not (every #'characterp ace-jump-mode-move-keys)))
+ (error "[AceJump] Invalid move keys: check ace-jump-mode-move-keys"))
+ ;; search candidate position
+ (let* ((visual-area-list (ace-jump-list-visual-area))
+ (candidate-list (ace-jump-search-candidate re-query-string visual-area-list)))
+ (cond
+ ;; cannot find any one
+ ((null candidate-list)
+ (setq ace-jump-current-mode nil)
+ (error "[AceJump] No one found"))
+ ;; we only find one, so move to it directly
+ ((eq (cdr candidate-list) nil)
+ (ace-jump-push-mark)
+ (run-hooks 'ace-jump-mode-before-jump-hook)
+ (ace-jump-jump-to (car candidate-list))
+ (message "[AceJump] One candidate, move to it directly")
+ (run-hooks 'ace-jump-mode-end-hook))
+ ;; more than one, we need to enter AceJump mode
+ (t
+ ;; make indirect buffer for those windows that show the same buffer
+ (setq ace-jump-recover-visual-area-list
+ (ace-jump-mode-make-indirect-buffer visual-area-list))
+ ;; create background for each visual area
+ (if ace-jump-mode-gray-background
+ (setq ace-jump-background-overlay-list
+ (loop for va in visual-area-list
+ collect (let* ((w (aj-visual-area-window va))
+ (b (aj-visual-area-buffer va))
+ (ol (make-overlay (window-start w)
+ (window-end w)
+ b)))
+ (overlay-put ol 'face 'ace-jump-face-background)
+ ol))))
+
+ ;; construct search tree and populate overlay into tree
+ (setq ace-jump-search-tree
+ (ace-jump-tree-breadth-first-construct (length candidate-list)
+ (length ace-jump-mode-move-keys)))
+ (ace-jump-populate-overlay-to-search-tree ace-jump-search-tree
+ candidate-list)
+ (ace-jump-update-overlay-in-search-tree ace-jump-search-tree
+ ace-jump-mode-move-keys)
+
+ ;; do minor mode configuration
+ (cond
+ ((eq ace-jump-current-mode 'ace-jump-char-mode)
+ (setq ace-jump-mode " AceJump - Char"))
+ ((eq ace-jump-current-mode 'ace-jump-word-mode)
+ (setq ace-jump-mode " AceJump - Word"))
+ ((eq ace-jump-current-mode 'ace-jump-line-mode)
+ (setq ace-jump-mode " AceJump - Line"))
+ (t
+ (setq ace-jump-mode " AceJump")))
+ (force-mode-line-update)
+
+
+ ;; override the local key map
+ (setq overriding-local-map
+ (let ( (map (make-keymap)) )
+ (dolist (key-code ace-jump-mode-move-keys)
+ (define-key map (make-string 1 key-code) 'ace-jump-move))
+ (define-key map (kbd "C-c C-c") 'ace-jump-quick-exchange)
+ (define-key map [t] 'ace-jump-done)
+ map))
+
+ (add-hook 'mouse-leave-buffer-hook 'ace-jump-done)
+ (add-hook 'kbd-macro-termination-hook 'ace-jump-done)))))
+
+
+(defun ace-jump-jump-to (position)
+ "Jump to the POSITION, which is a `aj-position' structure storing the position information"
+ (let ((offset (aj-position-offset position))
+ (frame (aj-position-frame position))
+ (window (aj-position-window position))
+ (buffer (aj-position-buffer position)))
+ ;; focus to the frame
+ (if (and (frame-live-p frame)
+ (not (eq frame (selected-frame))))
+ (select-frame-set-input-focus (window-frame window)))
+
+ ;; select the correct window
+ (if (and (window-live-p window)
+ (not (eq window (selected-window))))
+ (select-window window))
+
+ ;; swith to buffer
+ (if (and (buffer-live-p buffer)
+ (not (eq buffer (window-buffer window))))
+ (switch-to-buffer buffer))
+ ;; move to correct position
+
+ (if (and (buffer-live-p buffer)
+ (eq (current-buffer) buffer))
+ (goto-char offset))))
+
+(defun ace-jump-push-mark ()
+ "Push the current position information onto the `ace-jump-mode-mark-ring'."
+ ;; add mark to the emacs basic push mark
+ (push-mark (point) t)
+ ;; we also push the mark on the `ace-jump-mode-mark-ring', which has
+ ;; more information for better jump back
+ (let ((pos (make-aj-position :offset (point)
+ :visual-area (make-aj-visual-area :buffer (current-buffer)
+ :window (selected-window)
+ :frame (selected-frame)))))
+ (setq ace-jump-mode-mark-ring (cons pos ace-jump-mode-mark-ring)))
+ ;; when exeed the max count, discard the last one
+ (if (> (length ace-jump-mode-mark-ring) ace-jump-mode-mark-ring-max)
+ (setcdr (nthcdr (1- ace-jump-mode-mark-ring-max) ace-jump-mode-mark-ring) nil)))
+
+
+;;;###autoload
+(defun ace-jump-mode-pop-mark ()
+ "Pop up a postion from `ace-jump-mode-mark-ring', and jump back to that position"
+ (interactive)
+ ;; we jump over the killed buffer position
+ (while (and ace-jump-mode-mark-ring
+ (not (buffer-live-p (aj-position-buffer
+ (car ace-jump-mode-mark-ring)))))
+ (setq ace-jump-mode-mark-ring (cdr ace-jump-mode-mark-ring)))
+
+ (if (null ace-jump-mode-mark-ring)
+ ;; no valid history exist
+ (error "[AceJump] No more history"))
+
+ (if ace-jump-sync-emacs-mark-ring
+ (let ((p (car ace-jump-mode-mark-ring)))
+ ;; if we are jump back in the current buffer, that means we
+ ;; only need to sync the buffer local mark-ring
+ (if (eq (current-buffer) (aj-position-buffer p))
+ (if (equal (aj-position-offset p) (marker-position (mark-marker)))
+ ;; if the current marker is the same as where we need
+ ;; to jump back, we do the same as pop-mark actually,
+ ;; copy implementation from pop-mark, cannot use it
+ ;; directly, as there is advice on it
+ (when mark-ring
+ (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
+ (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
+ (move-marker (car mark-ring) nil)
+ (setq mark-ring (cdr mark-ring))
+ (deactivate-mark))
+
+ ;; But if there is other marker put before the wanted destination, the following scenario
+ ;;
+ ;; +---+---+---+---+ +---+---+---+---+
+ ;; Mark Ring | 2 | 3 | 4 | 5 | | 2 | 4 | 5 | 3 |
+ ;; +---+---+---+---+ +---+---+---+---+
+ ;; +---+ +---+
+ ;; Marker | 1 | | 1 | <-- Maker (not changed)
+ ;; +---+ +---+
+ ;; +---+ +---+
+ ;; Cursor | X | Pop up AJ mark 3 | 3 | <-- Cursor position
+ ;; +---+ +---+
+ ;; +---+---+---+ +---+---+---+
+ ;; AJ Ring | 3 | 4 | 5 | | 4 | 5 | 3 |
+ ;; +---+---+---+ +---+---+---+
+ ;;
+ ;; So what we need to do, is put the found mark in mark-ring to the end
+ (lexical-let ((po (aj-position-offset p)))
+ (setq mark-ring
+ (ace-jump-move-first-to-end-if mark-ring
+ (lambda (x)
+ (equal (marker-position x) po))))))
+
+
+ ;; when we jump back to another buffer, do as the
+ ;; pop-global-mark does. But we move the marker with the
+ ;; same target buffer to the end, not always the first one
+ (lexical-let ((pb (aj-position-buffer p)))
+ (setq global-mark-ring
+ (ace-jump-move-first-to-end-if global-mark-ring
+ (lambda (x)
+ (eq (marker-buffer x) pb))))))))
+
+
+ ;; move the first element to the end of the ring
+ (ace-jump-jump-to (car ace-jump-mode-mark-ring))
+ (setq ace-jump-mode-mark-ring (nconc (cdr ace-jump-mode-mark-ring)
+ (list (car ace-jump-mode-mark-ring)))))
+
+(defun ace-jump-quick-exchange ()
+ "The function that we can use to quick exhange the current mode between
+word-mode and char-mode"
+ (interactive)
+ (cond
+ ((eq ace-jump-current-mode 'ace-jump-char-mode)
+ (if ace-jump-query-char
+ ;; ace-jump-done will clean the query char, so we need to save it
+ (let ((query-char ace-jump-query-char))
+ (ace-jump-done)
+ (ace-jump-word-mode query-char))))
+ ((eq ace-jump-current-mode 'ace-jump-word-mode)
+ (if ace-jump-query-char
+ ;; ace-jump-done will clean the query char, so we need to save it
+ (let ((query-char ace-jump-query-char))
+ (ace-jump-done)
+ ;; restore the flag
+ (ace-jump-char-mode query-char))))
+ ((eq ace-jump-current-mode 'ace-jump-line-mode)
+ nil)
+ (t
+ nil)))
+
+
+
+
+;;;###autoload
+(defun ace-jump-char-mode (query-char)
+ "AceJump char mode"
+ (interactive (list (read-char "Query Char:")))
+
+ (if (eq (ace-jump-char-category query-char) 'other)
+ (error "[AceJump] Non-printable character"))
+
+ ;; others : digit , alpha, punc
+ (setq ace-jump-query-char query-char)
+ (setq ace-jump-current-mode 'ace-jump-char-mode)
+ (ace-jump-do (regexp-quote (make-string 1 query-char))))
+
+
+;;;###autoload
+(defun ace-jump-word-mode (head-char)
+ "AceJump word mode.
+You can set `ace-jump-word-mode-use-query-char' to nil to prevent
+asking for a head char, that will mark all the word in current
+buffer."
+ (interactive (list (if ace-jump-word-mode-use-query-char
+ (read-char "Head Char:")
+ nil)))
+ (cond
+ ((null head-char)
+ ;; \< - start of word
+ ;; \sw - word constituent
+ (ace-jump-do "\\<\\sw"))
+ ((memq (ace-jump-char-category head-char)
+ '(digit alpha))
+ (setq ace-jump-query-char head-char)
+ (setq ace-jump-current-mode 'ace-jump-word-mode)
+ (ace-jump-do (concat "\\<" (make-string 1 head-char))))
+ ((eq (ace-jump-char-category head-char)
+ 'punc)
+ ;; we do not query punctuation under word mode
+ (if (null ace-jump-mode-detect-punc)
+ (error "[AceJump] Not a valid word constituent"))
+ ;; we will use char mode to continue search
+ (setq ace-jump-query-char head-char)
+ (setq ace-jump-current-mode 'ace-jump-char-mode)
+ (ace-jump-do (regexp-quote (make-string 1 head-char))))
+ (t
+ (error "[AceJump] Non-printable character"))))
+
+
+;;;###autoload
+(defun ace-jump-line-mode ()
+ "AceJump line mode.
+Marked each no empty line and move there"
+ (interactive)
+ (setq ace-jump-current-mode 'ace-jump-line-mode)
+ (ace-jump-do "^"))
+
+;;;###autoload
+(defun ace-jump-mode(&optional prefix)
+ "AceJump mode is a minor mode for you to quick jump to a
+position in the curret view.
+ There is three submode now:
+ `ace-jump-char-mode'
+ `ace-jump-word-mode'
+ `ace-jump-line-mode'
+
+You can specify the sequence about which mode should enter
+by customize `ace-jump-mode-submode-list'.
+
+If you do not want to query char for word mode, you can change
+`ace-jump-word-mode-use-query-char' to nil.
+
+If you don't like the default move keys, you can change it by
+setting `ace-jump-mode-move-keys'.
+
+You can constrol whether use the case sensitive via
+`ace-jump-mode-case-fold'.
+"
+ (interactive "p")
+ (let ((index (/ prefix 4))
+ (submode-list-length (length ace-jump-mode-submode-list)))
+ (if (< index 0)
+ (error "[AceJump] Invalid prefix command"))
+ (if (>= index submode-list-length)
+ (setq index (1- submode-list-length)))
+ (call-interactively (nth index ace-jump-mode-submode-list))))
+
+(defun ace-jump-move ()
+ "move cursor based on user input"
+ (interactive)
+ (let* ((index (let ((ret (position (aref (this-command-keys) 0)
+ ace-jump-mode-move-keys)))
+ (if ret ret (length ace-jump-mode-move-keys))))
+ (node (nth index (cdr ace-jump-search-tree))))
+ (cond
+ ;; we do not find key in search tree. This can happen, for
+ ;; example, when there is only three selections in screen
+ ;; (totally five move-keys), but user press the forth move key
+ ((null node)
+ (message "No such position candidate.")
+ (ace-jump-done))
+ ;; this is a branch node, which means there need further
+ ;; selection
+ ((eq (car node) 'branch)
+ (let ((old-tree ace-jump-search-tree))
+ ;; we use sub tree in next move, create a new root node
+ ;; whose child is the sub tree nodes
+ (setq ace-jump-search-tree (cons 'branch (cdr node)))
+ (ace-jump-update-overlay-in-search-tree ace-jump-search-tree
+ ace-jump-mode-move-keys)
+
+ ;; this is important, we need remove the subtree first before
+ ;; do delete, we set the child nodes to nil
+ (setf (cdr node) nil)
+ (ace-jump-delete-overlay-in-search-tree old-tree)))
+ ;; if the node is leaf node, this is the final one
+ ((eq (car node) 'leaf)
+ ;; need to save aj data, as `ace-jump-done' will clean it
+ (let ((aj-data (overlay-get (cdr node) 'aj-data)))
+ (ace-jump-done)
+ (ace-jump-push-mark)
+ (run-hooks 'ace-jump-mode-before-jump-hook)
+ (ace-jump-jump-to aj-data))
+ (run-hooks 'ace-jump-mode-end-hook))
+ (t
+ (ace-jump-done)
+ (error "[AceJump] Internal error: tree node type is invalid")))))
+
+
+
+(defun ace-jump-done()
+ "stop AceJump motion"
+ (interactive)
+ ;; clear the status flag
+ (setq ace-jump-query-char nil)
+ (setq ace-jump-current-mode nil)
+
+ ;; clean the status line
+ (setq ace-jump-mode nil)
+ (force-mode-line-update)
+
+ ;; delete background overlay
+ (loop for ol in ace-jump-background-overlay-list
+ do (delete-overlay ol))
+ (setq ace-jump-background-overlay-list nil)
+
+
+ ;; we clean the indirect buffer
+ (loop for va in ace-jump-recover-visual-area-list
+ do (with-selected-window (aj-visual-area-window va)
+ (let ((fake-buffer (aj-visual-area-buffer va))
+ (original-buffer (aj-visual-area-recover-buffer va)))
+ ;; recover display buffer
+ (set-window-buffer (aj-visual-area-window va)
+ original-buffer)
+ ;; update visual area, which we need to use it to do the
+ ;; final jump, and as well, save in history
+ (setf (aj-visual-area-buffer va) original-buffer)
+ (setf (aj-visual-area-recover-buffer va) nil)
+ ;; kill indirect buffer
+ (kill-buffer fake-buffer))))
+
+ ;; delete overlays in search tree
+ (ace-jump-delete-overlay-in-search-tree ace-jump-search-tree)
+ (setq ace-jump-search-tree nil)
+
+ (setq overriding-local-map nil)
+
+ (remove-hook 'mouse-leave-buffer-hook 'ace-jump-done)
+ (remove-hook 'kbd-macro-termination-hook 'ace-jump-done))
+
+;;;; ============================================
+;;;; advice to sync emacs mark ring
+;;;; ============================================
+
+(defun ace-jump-move-to-end-if ( l pred )
+ "Move all the element in a list to the end of list if it make
+the PRED to return non-nil.
+
+PRED is a function object which can pass to funcall and accept
+one argument, which will be every element in the list.
+Such as : (lambda (x) (equal x 1)) "
+ (let (true-list false-list)
+ (loop for e in l
+ do (if (funcall pred e)
+ (setq true-list (cons e true-list))
+ (setq false-list (cons e false-list))))
+ (nconc (nreverse false-list)
+ (and true-list (nreverse true-list)))))
+
+(defun ace-jump-move-first-to-end-if (l pred)
+ "Only move the first found one to the end of list"
+ (lexical-let ((pred pred)
+ found)
+ (ace-jump-move-to-end-if l
+ (lambda (x)
+ (if found
+ nil
+ (setq found (funcall pred x)))))))
+
+
+
+(defadvice pop-mark (before ace-jump-pop-mark-advice)
+ "When `pop-mark' is called to jump back, this advice will sync the mark ring.
+Move the same position to the end of `ace-jump-mode-mark-ring'."
+ (lexical-let ((mp (mark t))
+ (cb (current-buffer)))
+ (if mp
+ (setq ace-jump-mode-mark-ring
+ (ace-jump-move-first-to-end-if ace-jump-mode-mark-ring
+ (lambda (x)
+ (and (equal (aj-position-offset x) mp)
+ (eq (aj-position-buffer x) cb))))))))
+
+
+(defadvice pop-global-mark (before ace-jump-pop-global-mark-advice)
+ "When `pop-global-mark' is called to jump back, this advice will sync the mark ring.
+Move the aj-position with the same buffer to the end of `ace-jump-mode-mark-ring'."
+ (interactive)
+ ;; find the one that will be jump to
+ (let ((index global-mark-ring))
+ ;; refer to the implementation of `pop-global-mark'
+ (while (and index (not (marker-buffer (car index))))
+ (setq index (cdr index)))
+ (if index
+ ;; find the mark
+ (lexical-let ((mb (marker-buffer (car index))))
+ (setq ace-jump-mode-mark-ring
+ (ace-jump-move-to-end-if ace-jump-mode-mark-ring
+ (lambda (x)
+ (eq (aj-position-buffer x) mb))))))))
+
+
+(defun ace-jump-mode-enable-mark-sync ()
+ "Enable the sync funciton between ace jump mode mark ring and emacs mark ring.
+
+1. This function will enable the advice which activate on
+`pop-mark' and `pop-global-mark'. These advice will remove the
+same marker from `ace-jump-mode-mark-ring' when user use
+`pop-mark' or `global-pop-mark' to jump back.
+
+2. Set variable `ace-jump-sync-emacs-mark-ring' to t, which will
+sync mark information with emacs mark ring. "
+ (ad-enable-advice 'pop-mark 'before 'ace-jump-pop-mark-advice)
+ (ad-activate 'pop-mark)
+ (ad-enable-advice 'pop-global-mark 'before 'ace-jump-pop-global-mark-advice)
+ (ad-activate 'pop-global-mark)
+ (setq ace-jump-sync-emacs-mark-ring t))
+
+(defun ace-jump-mode-disable-mark-sync ()
+ "Disable the sync funciton between ace jump mode mark ring and emacs mark ring.
+
+1. This function will diable the advice which activate on
+`pop-mark' and `pop-global-mark'. These advice will remove the
+same marker from `ace-jump-mode-mark-ring' when user use
+`pop-mark' or `global-pop-mark' to jump back.
+
+2. Set variable `ace-jump-sync-emacs-mark-ring' to nil, which
+will stop synchronizing mark information with emacs mark ring. "
+ (ad-disable-advice 'pop-mark 'before 'ace-jump-pop-mark-advice)
+ (ad-activate 'pop-mark)
+ (ad-disable-advice 'pop-global-mark 'before 'ace-jump-pop-global-mark-advice)
+ (ad-activate 'pop-global-mark)
+ (setq ace-jump-sync-emacs-mark-ring nil))
+
+
+(provide 'ace-jump-mode)
+
+;;; ace-jump-mode.el ends here
+
+;; Local Variables:
+;; byte-compile-warnings: (not cl-functions)
+;; End:
View
1,050 browse-kill-ring.el
@@ -0,0 +1,1050 @@
+;;; browse-kill-ring.el --- interactively insert items from kill-ring -*- coding: utf-8 -*-
+
+;; Copyright (C) 2001, 2002 Colin Walters <walters@verbum.org>
+
+;; Author: Colin Walters <walters@verbum.org>
+;; Maintainer: Nick Hurley <hurley@cis.ohio-state.edu>
+;; Created: 7 Apr 2001
+;; Version: 1.3a (CVS)
+;; X-RCS: $Id: browse-kill-ring.el,v 1.2 2008/10/29 00:23:00 hurley Exp $
+;; URL: http://freedom.cis.ohio-state.edu/~hurley/
+;; URL-ja: http://www.fan.gr.jp/~ring/doc/browse-kill-ring.html
+;; Keywords: convenience
+
+;; This file is not currently 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, 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 ; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Ever feel that 'C-y M-y M-y M-y ...' is not a great way of trying
+;; to find that piece of text you know you killed a while back? Then
+;; browse-kill-ring.el is for you.
+
+;; This package is simple to install; add (require 'browse-kill-ring)
+;; to your ~/.emacs file, after placing this file somewhere in your
+;; `load-path'. If you want to use 'M-y' to invoke
+;; `browse-kill-ring', also add (browse-kill-ring-default-keybindings)
+;; to your ~/.emacs file. Alternatively, you can bind it to another
+;; key such as "C-c k", with:
+;; (global-set-key (kbd "C-c k") 'browse-kill-ring)
+
+;; Note that the command keeps track of the last window displayed to
+;; handle insertion of chosen text; this might have unexpected
+;; consequences if you do 'M-x browse-kill-ring', then switch your
+;; window configuration, and try to use the same *Kill Ring* buffer
+;; again.
+
+;;; Change Log:
+
+;; Changes from 1.3 to 1.3a:
+
+;; * Sneak update by Benjamin Andresen <bandresen@gmail.com>
+;; * Added the read-only bugfix (http://bugs.debian.org/225082) from
+;; the emacs-goodies-el package
+
+;; Changes from 1.2 to 1.3:
+
+;; * New maintainer, Nick Hurley <hurley@cis.ohio-state.edu>
+;; * New functions `browse-kill-ring-prepend-insert', and
+;; `browse-kill-ring-append-insert', bound to 'b' and 'a' by
+;; default. There are also the unbound functions
+;; `browse-kill-ring-prepend-insert-and-quit',
+;; `browse-kill-ring-prepend-insert-and-move',
+;; `browse-kill-ring-prepend-insert-move-and-quit',
+;; `browse-kill-ring-append-insert-and-quit',
+;; `browse-kill-ring-append-insert-and-move',
+;; `browse-kill-ring-append-insert-move-and-quit'.
+
+;; Changes from 1.1 to 1.2:
+
+;; * New variable `browse-kill-ring-resize-window', which controls
+;; whether or not the browse-kill-ring window will try to resize
+;; itself to fit the buffer. Implementation from Juanma Barranquero
+;; <lektu@terra.es>.
+;; * New variable `browse-kill-ring-highlight-inserted-item'.
+;; Implementation from Yasutaka SHINDOH <ring-pub@fan.gr.jp>.
+;; * `browse-kill-ring-mouse-insert' (normally bound to mouse-2) now
+;; calls `browse-kill-ring-quit'.
+;; * Some non-user-visible code cleanup.
+;; * New variable `browse-kill-ring-recenter', implementation from
+;; René Kyllingstad <kyllingstad@users.sourceforge.net>.
+;; * Patch from Michal Maršuka <mmc@maruska.dyndns.org> which handles
+;; read-only text better.
+;; * New ability to move unkilled entries back to the beginning of the
+;; ring; patch from Yasutaka SHINDOH <ring-pub@fan.gr.jp>.
+;; * Do nothing if the user invokes `browse-kill-ring' when we're
+;; already in a *Kill Ring* buffer (initial patch from Juanma
+;; Barranquero <lektu@terra.es>).
+
+;; Changes from 1.0 to 1.1:
+
+;; * Important keybinding change! The default bindings of RET and 'i'
+;; have switched; this means typing RET now by default inserts the
+;; text and calls `browse-kill-ring-quit'; 'i' just inserts.
+;; * The variable `browse-kill-ring-use-fontification' is gone;
+;; browse-kill-ring.el has been rewritten to use font-lock. XEmacs
+;; users who want fontification will have to do:
+;; (add-hook 'browse-kill-ring-hook 'font-lock-mode)
+;; * Integrated code from Michael Slass <mikesl@wrq.com> into
+;; `browse-kill-ring-default-keybindings'.
+;; * New Japanese homepage for browse-kill-ring.el, thanks to
+;; Yasutaka SHINDOH <ring-pub@fan.gr.jp>.
+;; * Correctly restore window configuration after editing an entry.
+;; * New command `browse-kill-ring-insert-and-delete'.
+;; * Bug reports and patches from Michael Slass <mikesl@wrq.com> and
+;; Juanma Barranquero <lektu@terra.es>.
+
+;; Changes from 0.9b to 1.0:
+
+;; * Add autoload cookie to `browse-kill-ring'; suggestion from
+;; D. Goel <deego@glue.umd.edu> and Dave Pearson <davep@davep.org>.
+;; * Add keybinding tip from Michael Slass <mikesl@wrq.com>.
+
+;; Changes from 0.9a to 0.9b:
+
+;; * Remove extra parenthesis. Duh.
+
+;; Changes from 0.9 to 0.9a:
+
+;; * Fix bug making `browse-kill-ring-quit-action' uncustomizable.
+;; Patch from Henrik Enberg <henrik@enberg.org>.
+;; * Add `url-link' and `group' attributes to main Customization
+;; group.
+
+;; Changes from 0.8 to 0.9:
+
+;; * Add new function `browse-kill-ring-insert-and-quit', bound to 'i'
+;; by default (idea from Yasutaka Shindoh).
+;; * Make default `browse-kill-ring-quit-action' be
+;; `bury-and-delete-window', which handles the case of a single window
+;; more nicely.
+;; * Note change of home page and author address.
+
+;; Changes from 0.7 to 0.8:
+
+;; * Fix silly bug in `browse-kill-ring-edit' which made it impossible
+;; to edit entries.
+;; * New variable `browse-kill-ring-quit-action'.
+;; * `browse-kill-ring-restore' renamed to `browse-kill-ring-quit'.
+;; * Describe the keymaps in mode documentation. Patch from
+;; Marko Slyz <mslyz@eecs.umich.edu>.
+;; * Fix advice documentation for `browse-kill-ring-no-duplicates'.
+
+;; Changes from 0.6 to 0.7:
+
+;; * New functions `browse-kill-ring-search-forward' and
+;; `browse-kill-ring-search-backward', bound to "s" and "r" by
+;; default, respectively.
+;; * New function `browse-kill-ring-edit' bound to "e" by default, and
+;; a associated new major mode.
+;; * New function `browse-kill-ring-occur', bound to "l" by default.
+
+;; Changes from 0.5 to 0.6:
+
+;; * Fix bug in `browse-kill-ring-forward' which sometimes would cause
+;; a message "Wrong type argument: overlayp, nil" to appear.
+;; * New function `browse-kill-ring-update'.
+;; * New variable `browse-kill-ring-highlight-current-entry'.
+;; * New variable `browse-kill-ring-display-duplicates'.
+;; * New optional advice `browse-kill-ring-no-kill-new-duplicates',
+;; and associated variable `browse-kill-ring-no-duplicates'. Code
+;; from Klaus Berndl <Klaus.Berndl@sdm.de>.
+;; * Bind "?" to `describe-mode'. Patch from Dave Pearson
+;; <dave@davep.org>.
+;; * Fix typo in `browse-kill-ring-display-style' defcustom form.
+;; Thanks "Kahlil (Kal) HODGSON" <kahlil@discus.anu.edu.au>.
+
+;; Changes from 0.4 to 0.5:
+
+;; * New function `browse-kill-ring-delete', bound to "d" by default.
+;; * New function `browse-kill-ring-undo', bound to "U" by default.
+;; * New variable `browse-kill-ring-maximum-display-length'.
+;; * New variable `browse-kill-ring-use-fontification'.
+;; * New variable `browse-kill-ring-hook', called after the
+;; "*Kill Ring*" buffer is created.
+
+;; Changes from 0.3 to 0.4:
+
+;; * New functions `browse-kill-ring-forward' and
+;; `browse-kill-ring-previous', bound to "n" and "p" by default,
+;; respectively.
+;; * Change the default `browse-kill-ring-display-style' to
+;; `separated'.
+;; * Removed `browse-kill-ring-original-window-config'; Now
+;; `browse-kill-ring-restore' just buries the "*Kill Ring*" buffer
+;; and deletes its window, which is simpler and more intuitive.
+;; * New variable `browse-kill-ring-separator-face'.
+
+;;; Bugs:
+
+;; * Sometimes, in Emacs 21, the cursor will jump to the end of an
+;; entry when moving backwards using `browse-kill-ring-previous'.
+;; This doesn't seem to occur in Emacs 20 or XEmacs.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl)
+ (require 'derived))
+
+(when (featurep 'xemacs)
+ (require 'overlay))
+
+(defun browse-kill-ring-depropertize-string (str)
+ "Return a copy of STR with text properties removed."
+ (let ((str (copy-sequence str)))
+ (set-text-properties 0 (length str) nil str)
+ str))
+
+(cond ((fboundp 'propertize)
+ (defalias 'browse-kill-ring-propertize 'propertize))
+ ;; Maybe save some memory :)
+ ((fboundp 'ibuffer-propertize)
+ (defalias 'browse-kill-ring-propertize 'ibuffer-propertize))
+ (t
+ (defun browse-kill-ring-propertize (string &rest properties)
+ "Return a copy of STRING with text properties added.
+
+ [Note: this docstring has been copied from the Emacs 21 version]
+
+First argument is the string to copy.
+Remaining arguments form a sequence of PROPERTY VALUE pairs for text
+properties to add to the result."
+ (let ((str (copy-sequence string)))
+ (add-text-properties 0 (length str)
+ properties
+ str)
+ str))))
+
+(defgroup browse-kill-ring nil
+ "A package for browsing and inserting the items in `kill-ring'."
+ :link '(url-link "http://freedom.cis.ohio-state.edu/~hurley/")
+ :group 'convenience)
+
+(defvar browse-kill-ring-display-styles
+ '((separated . browse-kill-ring-insert-as-separated)
+ (one-line . browse-kill-ring-insert-as-one-line)))
+
+(defcustom browse-kill-ring-display-style 'separated
+ "How to display the kill ring items.
+
+If `one-line', then replace newlines with \"\\n\" for display.
+
+If `separated', then display `browse-kill-ring-separator' between
+entries."
+ :type '(choice (const :tag "One line" one-line)
+ (const :tag "Separated" separated))
+ :group 'browse-kill-ring)
+
+(defcustom browse-kill-ring-quit-action 'bury-and-delete-window
+ "What action to take when `browse-kill-ring-quit' is called.
+
+If `bury-buffer', then simply bury the *Kill Ring* buffer, but keep
+the window.
+
+If `bury-and-delete-window', then bury the buffer, and (if there is
+more than one window) delete the window. This is the default.
+
+If `save-and-restore', then save the window configuration when
+`browse-kill-ring' is called, and restore it at quit.
+
+If `kill-and-delete-window', then kill the *Kill Ring* buffer, and
+delete the window on close.
+
+Otherwise, it should be a function to call."
+ :type '(choice (const :tag "Bury buffer" :value bury-buffer)
+ (const :tag "Delete window" :value delete-window)
+ (const :tag "Save and restore" :value save-and-restore)
+ (const :tag "Bury buffer and delete window" :value bury-and-delete-window)
+ (const :tag "Kill buffer and delete window" :value kill-and-delete-window)
+ function)
+ :group 'browse-kill-ring)
+
+(defcustom browse-kill-ring-resize-window nil
+ "Whether to resize the `browse-kill-ring' window to fit its contents.
+Value is either t, meaning yes, or a cons pair of integers,
+ (MAXIMUM . MINIMUM) for the size of the window. MAXIMUM defaults to
+the window size chosen by `pop-to-buffer'; MINIMUM defaults to
+`window-min-height'."
+ :type '(choice (const :tag "No" nil)
+ (const :tag "Yes" t)
+ (cons (integer :tag "Maximum") (integer :tag "Minimum")))
+ :group 'browse-kill-ring)
+
+(defcustom browse-kill-ring-separator "-------"
+ "The string separating entries in the `separated' style.
+See `browse-kill-ring-display-style'."
+ :type 'string
+ :group 'browse-kill-ring)
+
+(defcustom browse-kill-ring-recenter nil
+ "If non-nil, then always keep the current entry at the top of the window."
+ :type 'boolean
+ :group 'browse-kill-ring)
+
+(defcustom browse-kill-ring-highlight-current-entry nil
+ "If non-nil, highlight the currently selected `kill-ring' entry."
+ :type 'boolean
+ :group 'browse-kill-ring)
+
+(defcustom browse-kill-ring-highlight-inserted-item browse-kill-ring-highlight-current-entry
+ "If non-nil, temporarily highlight the inserted `kill-ring' entry."
+ :type 'boolean
+ :group 'browse-kill-ring)
+
+(defcustom browse-kill-ring-separator-face 'bold
+ "The face in which to highlight the `browse-kill-ring-separator'."
+ :type 'face
+ :group 'browse-kill-ring)
+
+(defcustom browse-kill-ring-maximum-display-length nil
+ "Whether or not to limit the length of displayed items.
+
+If this variable is an integer, the display of `kill-ring' will be
+limited to that many characters.
+Setting this variable to nil means no limit."
+ :type '(choice (const :tag "None" nil)
+ integer)
+ :group 'browse-kill-ring)
+
+(defcustom browse-kill-ring-display-duplicates t
+ "If non-nil, then display duplicate items in `kill-ring'."
+ :type 'boolean
+ :group 'browse-kill-ring)
+
+(defadvice kill-new (around browse-kill-ring-no-kill-new-duplicates)
+ "An advice for not adding duplicate elements to `kill-ring'.
+Even after being \"activated\", this advice will only modify the
+behavior of `kill-new' when `browse-kill-ring-no-duplicates'
+is non-nil."
+ (if browse-kill-ring-no-duplicates
+ (setq kill-ring (delete (ad-get-arg 0) kill-ring)))
+ ad-do-it)
+
+(defcustom browse-kill-ring-no-duplicates nil
+ "If non-nil, then the `b-k-r-no-kill-new-duplicates' advice will operate.
+This means that duplicate entries won't be added to the `kill-ring'
+when you call `kill-new'.
+
+If you set this variable via customize, the advice will be activated
+or deactivated automatically. Otherwise, to enable the advice, add
+
+ (ad-enable-advice 'kill-new 'around 'browse-kill-ring-no-kill-new-duplicates)
+ (ad-activate 'kill-new)
+
+to your init file."
+ :type 'boolean
+ :set (lambda (symbol value)
+ (set symbol value)
+ (if value
+ (ad-enable-advice 'kill-new 'around
+ 'browse-kill-ring-no-kill-new-duplicates)
+ (ad-disable-advice 'kill-new 'around
+ 'browse-kill-ring-no-kill-new-duplicates))
+ (ad-activate 'kill-new))
+ :group 'browse-kill-ring)
+
+(defcustom browse-kill-ring-depropertize nil
+ "If non-nil, remove text properties from `kill-ring' items.
+This only changes the items for display and insertion from
+`browse-kill-ring'; if you call `yank' directly, the items will be
+inserted with properties."
+ :type 'boolean
+ :group 'browse-kill-ring)
+
+(defcustom browse-kill-ring-hook nil
+ "A list of functions to call after `browse-kill-ring'."
+ :type 'hook
+ :group 'browse-kill-ring)
+
+(defvar browse-kill-ring-original-window-config nil
+ "The window configuration to restore for `browse-kill-ring-quit'.")
+(make-variable-buffer-local 'browse-kill-ring-original-window-config)
+
+(defvar browse-kill-ring-original-window nil
+ "The window in which chosen kill ring data will be inserted.
+It is probably not a good idea to set this variable directly; simply
+call `browse-kill-ring' again.")
+
+(defun browse-kill-ring-mouse-insert (e)
+ "Insert the chosen text, and close the *Kill Ring* buffer afterwards."
+ (interactive "e")
+ (let* ((data (save-excursion
+ (mouse-set-point e)
+ (cons (current-buffer) (point))))
+ (buf (car data))
+ (pt (cdr data)))
+ (browse-kill-ring-do-insert buf pt))
+ (browse-kill-ring-quit))
+
+(if (fboundp 'fit-window-to-buffer)
+ (defalias 'browse-kill-ring-fit-window 'fit-window-to-buffer)
+ (defun browse-kill-ring-fit-window (window max-height min-height)
+ (setq min-height (or min-height window-min-height))
+ (setq max-height (or max-height (- (frame-height) (window-height) 1)))
+ (let* ((window-min-height min-height)
+ (windows (count-windows))
+ (config (current-window-configuration)))
+ (enlarge-window (- max-height (window-height)))
+ (when (> windows (count-windows))
+ (set-window-configuration config))
+ (if (/= (point-min) (point-max))
+ (shrink-window-if-larger-than-buffer window)
+ (shrink-window (- (window-height) window-min-height))))))
+
+(defun browse-kill-ring-resize-window ()
+ (when browse-kill-ring-resize-window
+ (apply #'browse-kill-ring-fit-window (selected-window)
+ (if (consp browse-kill-ring-resize-window)
+ (list (car browse-kill-ring-resize-window)
+ (or (cdr browse-kill-ring-resize-window)
+ window-min-height))
+ (list nil window-min-height)))))
+
+(defun browse-kill-ring-undo-other-window ()
+ "Undo the most recent change in the other window's buffer.
+You most likely want to use this command for undoing an insertion of
+yanked text from the *Kill Ring* buffer."
+ (interactive)
+ (with-current-buffer (window-buffer browse-kill-ring-original-window)
+ (undo)))
+
+(defun browse-kill-ring-insert (&optional quit)
+ "Insert the kill ring item at point into the last selected buffer.
+If optional argument QUIT is non-nil, close the *Kill Ring* buffer as
+well."
+ (interactive "P")
+ (browse-kill-ring-do-insert (current-buffer)
+ (point))
+ (when quit
+ (browse-kill-ring-quit)))
+
+(defun browse-kill-ring-insert-and-delete (&optional quit)
+ "Insert the kill ring item at point, and remove it from the kill ring.
+If optional argument QUIT is non-nil, close the *Kill Ring* buffer as
+well."
+ (interactive "P")
+ (browse-kill-ring-do-insert (current-buffer)
+ (point))
+ (browse-kill-ring-delete)
+ (when quit
+ (browse-kill-ring-quit)))
+
+(defun browse-kill-ring-insert-and-quit ()
+ "Like `browse-kill-ring-insert', but close the *Kill Ring* buffer afterwards."
+ (interactive)
+ (browse-kill-ring-insert t))
+
+(defun browse-kill-ring-insert-and-move (&optional quit)
+ "Like `browse-kill-ring-insert', but move the entry to the front."
+ (interactive "P")
+ (let ((buf (current-buffer))
+ (pt (point)))
+ (browse-kill-ring-do-insert buf pt)
+ (let ((str (browse-kill-ring-current-string buf pt)))
+ (browse-kill-ring-delete)
+ (kill-new str)))
+ (if quit
+ (browse-kill-ring-quit)
+ (browse-kill-ring-update)))
+
+(defun browse-kill-ring-insert-move-and-quit ()
+ "Like `browse-kill-ring-insert-and-move', but close the *Kill Ring* buffer."
+ (interactive)
+ (browse-kill-ring-insert-and-move t))
+
+(defun browse-kill-ring-prepend-insert (&optional quit)
+ "Like `browse-kill-ring-insert', but it places the entry at the beginning
+of the buffer as opposed to point."
+ (interactive "P")
+ (browse-kill-ring-do-prepend-insert (current-buffer)
+ (point))
+ (when quit
+ (browse-kill-ring-quit)))
+
+(defun browse-kill-ring-prepend-insert-and-quit ()
+ "Like `browse-kill-ring-prepend-insert', but close the *Kill Ring* buffer."
+ (interactive)
+ (browse-kill-ring-prepend-insert t))
+
+(defun browse-kill-ring-prepend-insert-and-move (&optional quit)
+ "Like `browse-kill-ring-prepend-insert', but move the entry to the front
+of the *Kill Ring*."
+ (interactive "P")
+ (let ((buf (current-buffer))
+ (pt (point)))
+ (browse-kill-ring-do-prepend-insert buf pt)
+ (let ((str (browse-kill-ring-current-string buf pt)))
+ (browse-kill-ring-delete)
+ (kill-new str)))
+ (if quit
+ (browse-kill-ring-quit)
+ (browse-kill-ring-update)))
+
+(defun browse-kill-ring-prepend-insert-move-and-quit ()
+ "Like `browse-kill-ring-prepend-insert-and-move', but close the
+*Kill Ring* buffer."
+ (interactive)
+ (browse-kill-ring-prepend-insert-and-move t))
+
+(defun browse-kill-ring-do-prepend-insert (buf pt)
+ (let ((str (browse-kill-ring-current-string buf pt)))
+ (let ((orig (current-buffer)))
+ (unwind-protect
+ (progn
+ (unless (window-live-p browse-kill-ring-original-window)
+ (error "Window %s has been deleted; Try calling `browse-kill-ring' again"
+ browse-kill-ring-original-window))
+ (set-buffer (window-buffer browse-kill-ring-original-window))
+ (save-excursion
+ (let ((pt (point)))
+ (goto-char (point-min))
+ (insert (if browse-kill-ring-depropertize
+ (browse-kill-ring-depropertize-string str)
+ str))
+ (when browse-kill-ring-highlight-inserted-item
+ (let ((o (make-overlay (point-min) (point))))
+ (overlay-put o 'face 'highlight)
+ (sit-for 0.5)
+ (delete-overlay o)))
+ (goto-char pt))))
+ (set-buffer orig)))))
+
+(defun browse-kill-ring-append-insert (&optional quit)
+ "Like `browse-kill-ring-insert', but places the entry at the end of the
+buffer as opposed to point."
+ (interactive "P")
+ (browse-kill-ring-do-append-insert (current-buffer)
+ (point))
+ (when quit
+ (browse-kill-ring-quit)))
+
+(defun browse-kill-ring-append-insert-and-quit ()
+ "Like `browse-kill-ring-append-insert', but close the *Kill Ring* buffer."
+ (interactive)
+ (browse-kill-ring-append-insert t))
+
+(defun browse-kill-ring-append-insert-and-move (&optional quit)
+ "Like `browse-kill-ring-append-insert', but move the entry to the front
+of the *Kill Ring*."
+ (interactive "P")
+ (let ((buf (current-buffer))
+ (pt (point)))
+ (browse-kill-ring-do-append-insert buf pt)
+ (let ((str (browse-kill-ring-current-string buf pt)))
+ (browse-kill-ring-delete)
+ (kill-new str)))
+ (if quit
+ (browse-kill-ring-quit)
+ (browse-kill-ring-update)))
+
+(defun browse-kill-ring-append-insert-move-and-quit ()
+ "Like `browse-kill-ring-append-insert-and-move', but close the
+*Kill Ring* buffer."
+ (interactive)
+ (browse-kill-ring-append-insert-and-move t))
+
+(defun browse-kill-ring-do-append-insert (buf pt)
+ (let ((str (browse-kill-ring-current-string buf pt)))
+ (let ((orig (current-buffer)))
+ (unwind-protect
+ (progn
+ (unless (window-live-p browse-kill-ring-original-window)
+ (error "Window %s has been deleted; Try calling `browse-kill-ring' again"
+ browse-kill-ring-original-window))
+ (set-buffer (window-buffer browse-kill-ring-original-window))
+ (save-excursion
+ (let ((pt (point))
+ (begin-pt (point-max)))
+ (goto-char begin-pt)
+ (insert (if browse-kill-ring-depropertize
+ (browse-kill-ring-depropertize-string str)
+ str))
+ (when browse-kill-ring-highlight-inserted-item
+ (let ((o (make-overlay begin-pt (point-max))))
+ (overlay-put o 'face 'highlight)
+ (sit-for 0.5)
+ (delete-overlay o)))
+ (goto-char pt))))
+ (set-buffer orig)))))
+
+(defun browse-kill-ring-delete ()
+ "Remove the item at point from the `kill-ring'."
+ (interactive)
+ (let ((over (car (overlays-at (point)))))
+ (unless (overlayp over)
+ (error "No kill ring item here"))
+ (unwind-protect
+ (progn
+ (setq buffer-read-only nil)
+ (let ((target (overlay-get over 'browse-kill-ring-target)))
+ (delete-region (overlay-start over)
+ (1+ (overlay-end over)))
+ (setq kill-ring (delete target kill-ring)))
+ (when (get-text-property (point) 'browse-kill-ring-extra)
+ (let ((prev (previous-single-property-change (point)
+ 'browse-kill-ring-extra))
+ (next (next-single-property-change (point)
+ 'browse-kill-ring-extra)))
+ ;; This is some voodoo.
+ (when prev
+ (incf prev))
+ (when next
+ (incf next))
+ (delete-region (or prev (point-min))
+ (or next (point-max))))))
+ (setq buffer-read-only t)))
+ (browse-kill-ring-resize-window)
+ (browse-kill-ring-forward 0))
+
+(defun browse-kill-ring-current-string (buf pt)
+ (with-current-buffer buf
+ (let ((overs (overlays-at pt)))
+ (or (and overs
+ (overlay-get (car overs) 'browse-kill-ring-target))
+ (error "No kill ring item here")))))
+
+(defun browse-kill-ring-do-insert (buf pt)
+ (let ((str (browse-kill-ring-current-string buf pt)))
+ (let ((orig (current-buffer)))
+ (unwind-protect
+ (progn
+ (unless (window-live-p browse-kill-ring-original-window)
+ (error "Window %s has been deleted; Try calling `browse-kill-ring' again"
+ browse-kill-ring-original-window))
+ (set-buffer (window-buffer browse-kill-ring-original-window))
+ (save-excursion
+ (let ((pt (point)))
+ (insert (if browse-kill-ring-depropertize
+ (browse-kill-ring-depropertize-string str)
+ str))
+ (when browse-kill-ring-highlight-inserted-item
+ (let ((o (make-overlay pt (point))))
+ (overlay-put o 'face 'highlight)
+ (sit-for 0.5)
+ (delete-overlay o))))))
+ (set-buffer orig)))))
+
+(defun browse-kill-ring-forward (&optional arg)
+ "Move forward by ARG `kill-ring' entries."
+ (interactive "p")
+ (beginning-of-line)
+ (while (not (zerop arg))
+ (if (< arg 0)
+ (progn
+ (incf arg)
+ (if (overlays-at (point))
+ (progn
+ (goto-char (overlay-start (car (overlays-at (point)))))
+ (goto-char (previous-overlay-change (point)))
+ (goto-char (previous-overlay-change (point))))
+ (progn
+ (goto-char (1- (previous-overlay-change (point))))
+ (unless (bobp)
+ (goto-char (overlay-start (car (overlays-at (point)))))))))
+ (progn
+ (decf arg)
+ (if (overlays-at (point))
+ (progn
+ (goto-char (overlay-end (car (overlays-at (point)))))
+ (goto-char (next-overlay-change (point))))
+ (goto-char (next-overlay-change (point)))
+ (unless (eobp)
+ (goto-char (overlay-start (car (overlays-at (point))))))))))
+ ;; This could probably be implemented in a more intelligent manner.
+ ;; Perhaps keep track over the overlay we started from? That would
+ ;; break when the user moved manually, though.
+ (when (and browse-kill-ring-highlight-current-entry
+ (overlays-at (point)))
+ (let ((overs (overlay-lists))
+ (current-overlay (car (overlays-at (point)))))
+ (mapcar #'(lambda (o)
+ (overlay-put o 'face nil))
+ (nconc (car overs) (cdr overs)))
+ (overlay-put current-overlay 'face 'highlight)))
+ (when browse-kill-ring-recenter
+ (recenter 1)))
+
+(defun browse-kill-ring-previous (&optional arg)
+ "Move backward by ARG `kill-ring' entries."
+ (interactive "p")
+ (browse-kill-ring-forward (- arg)))
+
+(defun browse-kill-ring-read-regexp (msg)
+ (let* ((default (car regexp-history))
+ (input
+ (read-from-minibuffer
+ (if default
+ (format "%s for regexp (default `%s'): "
+ msg
+ default)
+ (format "%s (regexp): " msg))
+ nil
+ nil
+ nil
+ 'regexp-history)))
+ (if (equal input "")
+ default
+ input)))
+
+(defun browse-kill-ring-search-forward (regexp &optional backwards)
+ "Move to the next `kill-ring' entry matching REGEXP from point.
+If optional arg BACKWARDS is non-nil, move to the previous matching
+entry."
+ (interactive
+ (list (browse-kill-ring-read-regexp "Search forward")
+ current-prefix-arg))
+ (let ((orig (point)))
+ (browse-kill-ring-forward (if backwards -1 1))
+ (let ((overs (overlays-at (point))))
+ (while (and overs
+ (not (if backwards (bobp) (eobp)))
+ (not (string-match regexp
+ (overlay-get (car overs)
+ 'browse-kill-ring-target))))
+ (browse-kill-ring-forward (if backwards -1 1))
+ (setq overs (overlays-at (point))))
+ (unless (and overs
+ (string-match regexp
+ (overlay-get (car overs)
+ 'browse-kill-ring-target)))
+ (progn
+ (goto-char orig)
+ (message "No more `kill-ring' entries matching %s" regexp))))))
+
+(defun browse-kill-ring-search-backward (regexp)
+ "Move to the previous `kill-ring' entry matching REGEXP from point."
+ (interactive
+ (list (browse-kill-ring-read-regexp "Search backward")))
+ (browse-kill-ring-search-forward regexp t))
+
+(defun browse-kill-ring-quit ()
+ "Take the action specified by `browse-kill-ring-quit-action'."
+ (interactive)
+ (case browse-kill-ring-quit-action
+ (save-and-restore
+ (let (buf (current-buffer))
+ (set-window-configuration browse-kill-ring-original-window-config)
+ (kill-buffer buf)))
+ (kill-and-delete-window
+ (kill-buffer (current-buffer))
+ (unless (= (count-windows) 1)
+ (delete-window)))
+ (bury-and-delete-window
+ (bury-buffer)
+ (unless (= (count-windows) 1)
+ (delete-window)))
+ (t
+ (funcall browse-kill-ring-quit-action))))
+
+(put 'browse-kill-ring-mode 'mode-class 'special)
+(define-derived-mode browse-kill-ring-mode fundamental-mode
+ "Kill Ring"
+ "A major mode for browsing the `kill-ring'.
+You most likely do not want to call `browse-kill-ring-mode' directly; use
+`browse-kill-ring' instead.
+
+\\{browse-kill-ring-mode-map}"
+ (set (make-local-variable 'font-lock-defaults)
+ '(nil t nil nil nil
+ (font-lock-fontify-region-function . browse-kill-ring-fontify-region)))
+ (define-key browse-kill-ring-mode-map (kbd "q") 'browse-kill-ring-quit)
+ (define-key browse-kill-ring-mode-map (kbd "U") 'browse-kill-ring-undo-other-window)
+ (define-key browse-kill-ring-mode-map (kbd "d") 'browse-kill-ring-delete)
+ (define-key browse-kill-ring-mode-map (kbd "s") 'browse-kill-ring-search-forward)
+ (define-key browse-kill-ring-mode-map (kbd "r") 'browse-kill-ring-search-backward)
+ (define-key browse-kill-ring-mode-map (kbd "g") 'browse-kill-ring-update)
+ (define-key browse-kill-ring-mode-map (kbd "l") 'browse-kill-ring-occur)
+ (define-key browse-kill-ring-mode-map (kbd "e") 'browse-kill-ring-edit)
+ (define-key browse-kill-ring-mode-map (kbd "n") 'browse-kill-ring-forward)
+ (define-key browse-kill-ring-mode-map (kbd "p") 'browse-kill-ring-previous)
+ (define-key browse-kill-ring-mode-map [(mouse-2)] 'browse-kill-ring-mouse-insert)
+ (define-key browse-kill-ring-mode-map (kbd "?") 'describe-mode)
+ (define-key browse-kill-ring-mode-map (kbd "h") 'describe-mode)
+ (define-key browse-kill-ring-mode-map (kbd "y") 'browse-kill-ring-insert)
+ (define-key browse-kill-ring-mode-map (kbd "u") 'browse-kill-ring-insert-move-and-quit)
+ (define-key browse-kill-ring-mode-map (kbd "i") 'browse-kill-ring-insert)
+ (define-key browse-kill-ring-mode-map (kbd "o") 'browse-kill-ring-insert-and-move)
+ (define-key browse-kill-ring-mode-map (kbd "x") 'browse-kill-ring-insert-and-delete)
+ (define-key browse-kill-ring-mode-map (kbd "RET") 'browse-kill-ring-insert-and-quit)
+ (define-key browse-kill-ring-mode-map (kbd "b") 'browse-kill-ring-prepend-insert)
+ (define-key browse-kill-ring-mode-map (kbd "a") 'browse-kill-ring-append-insert))
+
+;;;###autoload
+(defun browse-kill-ring-default-keybindings ()
+ "Set up M-y (`yank-pop') so that it can invoke `browse-kill-ring'.
+Normally, if M-y was not preceeded by C-y, then it has no useful
+behavior. This function sets things up so that M-y will invoke
+`browse-kill-ring'."
+ (interactive)
+ (defadvice yank-pop (around kill-ring-browse-maybe (arg))
+ "If last action was not a yank, run `browse-kill-ring' instead."
+ ;; yank-pop has an (interactive "*p") form which does not allow
+ ;; it to run in a read-only buffer. We want browse-kill-ring to
+ ;; be allowed to run in a read only buffer, so we change the
+ ;; interactive form here. In that case, we need to
+ ;; barf-if-buffer-read-only if we're going to call yank-pop with
+ ;; ad-do-it
+ (interactive "p")
+ (if (not (eq last-command 'yank))
+ (browse-kill-ring)
+ (barf-if-buffer-read-only)
+ ad-do-it))
+ (ad-activate 'yank-pop))
+
+(define-derived-mode browse-kill-ring-edit-mode fundamental-mode
+ "Kill Ring Edit"
+ "A major mode for editing a `kill-ring' entry.
+You most likely do not want to call `browse-kill-ring-edit-mode'
+directly; use `browse-kill-ring' instead.
+
+\\{browse-kill-ring-edit-mode-map}"
+ (define-key browse-kill-ring-edit-mode-map (kbd "C-c C-c")
+ 'browse-kill-ring-edit-finish))
+
+(defvar browse-kill-ring-edit-target nil)
+(make-variable-buffer-local 'browse-kill-ring-edit-target)
+
+(defun browse-kill-ring-edit ()
+ "Edit the `kill-ring' entry at point."
+ (interactive)
+ (let ((overs (overlays-at (point))))
+ (unless overs
+ (error "No kill ring entry here"))
+ (let* ((target (overlay-get (car overs)
+ 'browse-kill-ring-target))
+ (target-cell (member target kill-ring)))
+ (unless target-cell
+ (error "Item deleted from the kill-ring"))
+ (switch-to-buffer (get-buffer-create "*Kill Ring Edit*"))
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (insert target)
+ (goto-char (point-min))
+ (browse-kill-ring-resize-window)
+ (browse-kill-ring-edit-mode)
+ (message "%s"
+ (substitute-command-keys
+ "Use \\[browse-kill-ring-edit-finish] to finish editing."))
+ (setq browse-kill-ring-edit-target target-cell))))
+
+(defun browse-kill-ring-edit-finish ()
+ "Commit the changes to the `kill-ring'."
+ (interactive)
+ (if browse-kill-ring-edit-target
+ (setcar browse-kill-ring-edit-target (buffer-string))
+ (when (y-or-n-p "The item has been deleted; add to front? ")
+ (push (buffer-string) kill-ring)))
+ (bury-buffer)
+ ;; The user might have rearranged the windows
+ (when (eq major-mode 'browse-kill-ring-mode)
+ (browse-kill-ring-setup (current-buffer)
+ browse-kill-ring-original-window
+ nil
+ browse-kill-ring-original-window-config)
+ (browse-kill-ring-resize-window)))
+
+(defmacro browse-kill-ring-add-overlays-for (item &rest body)
+ (let ((beg (gensym "browse-kill-ring-add-overlays-"))
+ (end (gensym "browse-kill-ring-add-overlays-")))
+ `(let ((,beg (point))
+ (,end
+ (progn
+ ,@body
+ (point))))
+ (let ((o (make-overlay ,beg ,end)))
+ (overlay-put o 'browse-kill-ring-target ,item)
+ (overlay-put o 'mouse-face 'highlight)))))
+;; (put 'browse-kill-ring-add-overlays-for 'lisp-indent-function 1)
+
+(defun browse-kill-ring-elide (str)
+ (if (and browse-kill-ring-maximum-display-length
+ (> (length str)
+ browse-kill-ring-maximum-display-length))
+ (concat (substring str 0 (- browse-kill-ring-maximum-display-length 3))
+ (browse-kill-ring-propertize "..." 'browse-kill-ring-extra t))
+ str))
+
+(defun browse-kill-ring-insert-as-one-line (items)
+ (dolist (item items)
+ (browse-kill-ring-add-overlays-for item
+ (let* ((item (browse-kill-ring-elide item))
+ (len (length item))
+ (start 0)
+ (newl (browse-kill-ring-propertize "\\n" 'browse-kill-ring-extra t)))
+ (while (and (< start len)
+ (string-match "\n" item start))
+ (insert (substring item start (match-beginning 0))
+ newl)
+ (setq start (match-end 0)))
+ (insert (substring item start len))))
+ (insert "\n")))
+
+(defun browse-kill-ring-insert-as-separated (items)
+ (while (cdr items)
+ (browse-kill-ring-insert-as-separated-1 (car items) t)
+ (setq items (cdr items)))
+ (when items
+ (browse-kill-ring-insert-as-separated-1 (car items) nil)))
+
+(defun browse-kill-ring-insert-as-separated-1 (origitem separatep)
+ (let* ((item (browse-kill-ring-elide origitem))
+ (len (length item)))
+ (browse-kill-ring-add-overlays-for origitem
+ (insert item))
+ ;; When the kill-ring has items with read-only text property at
+ ;; **the end of** string, browse-kill-ring-setup fails with error
+ ;; `Text is read-only'. So inhibit-read-only here.
+ ;; See http://bugs.debian.org/225082
+ ;; - INOUE Hiroyuki <dombly@kc4.so-net.ne.jp>
+ (let ((inhibit-read-only t))
+ (insert "\n")
+ (when separatep
+ (insert (browse-kill-ring-propertize browse-kill-ring-separator
+ 'browse-kill-ring-extra t
+ 'browse-kill-ring-separator t))
+ (insert "\n")))))
+
+(defun browse-kill-ring-occur (regexp)
+ "Display all `kill-ring' entries matching REGEXP."
+ (interactive
+ (list
+ (browse-kill-ring-read-regexp "Display kill ring entries matching")))
+ (assert (eq major-mode 'browse-kill-ring-mode))
+ (browse-kill-ring-setup (current-buffer)
+ browse-kill-ring-original-window
+ regexp)
+ (browse-kill-ring-resize-window))
+
+(defun browse-kill-ring-fontify-on-property (prop face beg end)
+ (save-excursion
+ (goto-char beg)
+ (let ((prop-end nil))
+ (while
+ (setq prop-end
+ (let ((prop-beg (or (and (get-text-property (point) prop) (point))
+ (next-single-property-change (point) prop nil end))))
+ (when (and prop-beg (not (= prop-beg end)))
+ (let ((prop-end (next-single-property-change prop-beg prop nil end)))
+ (when (and prop-end (not (= prop-end end)))
+ (put-text-property prop-beg prop-end 'face face)
+ prop-end)))))
+ (goto-char prop-end)))))
+
+(defun browse-kill-ring-fontify-region (beg end &optional verbose)
+ (when verbose (message "Fontifying..."))
+ (let ((buffer-read-only nil))
+ (browse-kill-ring-fontify-on-property 'browse-kill-ring-extra 'bold beg end)
+ (browse-kill-ring-fontify-on-property 'browse-kill-ring-separator
+ browse-kill-ring-separator-face beg end))
+ (when verbose (message "Fontifying...done")))
+
+(defun browse-kill-ring-update ()
+ "Update the buffer to reflect outside changes to `kill-ring'."
+ (interactive)
+ (assert (eq major-mode 'browse-kill-ring-mode))
+ (browse-kill-ring-setup (current-buffer)
+ browse-kill-ring-original-window)
+ (browse-kill-ring-resize-window))
+
+(defun browse-kill-ring-setup (buf window &optional regexp window-config)
+ (with-current-buffer buf
+ (unwind-protect
+ (progn
+ (browse-kill-ring-mode)
+ (setq buffer-read-only nil)
+ (when (eq browse-kill-ring-display-style
+ 'one-line)
+ (setq truncate-lines t))
+ (let ((inhibit-read-only t))
+ (erase-buffer))
+ (setq browse-kill-ring-original-window window
+ browse-kill-ring-original-window-config
+ (or window-config
+ (current-window-configuration)))
+ (let ((browse-kill-ring-maximum-display-length
+ (if (and browse-kill-ring-maximum-display-length
+ (<= browse-kill-ring-maximum-display-length 3))
+ 4
+ browse-kill-ring-maximum-display-length))
+ (items (mapcar
+ (if browse-kill-ring-depropertize
+ #'browse-kill-ring-depropertize-string
+ #'copy-sequence)
+ kill-ring)))
+ (when (not browse-kill-ring-display-duplicates)
+ ;; I'm not going to rewrite `delete-duplicates'. If
+ ;; someone really wants to rewrite it here, send me a
+ ;; patch.
+ (require 'cl)
+ (setq items (delete-duplicates items :test #'equal)))
+ (when (stringp regexp)
+ (setq items (delq nil
+ (mapcar
+ #'(lambda (item)
+ (when (string-match regexp item)
+ item))
+ items))))
+ (funcall (or (cdr (assq browse-kill-ring-display-style
+ browse-kill-ring-display-styles))
+ (error "Invalid `browse-kill-ring-display-style': %s"
+ browse-kill-ring-display-style))
+ items)
+;; Code from Michael Slass <mikesl@wrq.com>
+ (message
+ (let ((entry (if (= 1 (length kill-ring)) "entry" "entries")))
+ (concat
+ (if (and (not regexp)
+ browse-kill-ring-display-duplicates)
+ (format "%s %s in the kill ring."
+ (length kill-ring) entry)
+ (format "%s (of %s) %s in the kill ring shown."
+ (length items) (length kill-ring) entry))
+ (substitute-command-keys
+ (concat " Type \\[browse-kill-ring-quit] to quit. "
+ "\\[describe-mode] for help.")))))
+;; End code from Michael Slass <mikesl@wrq.com>
+ (set-buffer-modified-p nil)
+ (goto-char (point-min))
+ (browse-kill-ring-forward 0)
+ (when regexp
+ (setq mode-name (concat "Kill Ring [" regexp "]")))
+ (run-hooks 'browse-kill-ring-hook)
+ ;; I will be very glad when I can get rid of this gross
+ ;; hack, which solely exists for XEmacs users.
+ (when (and (featurep 'xemacs)
+ font-lock-mode)
+ (browse-kill-ring-fontify-region (point-min) (point-max)))))
+ (progn
+ (setq buffer-read-only t)))))
+
+;;;###autoload
+(defun browse-kill-ring ()
+ "Display items in the `kill-ring' in another buffer."
+ (interactive)
+ (if (eq major-mode 'browse-kill-ring-mode)
+ (message "Already viewing the kill ring")
+ (let ((orig-buf (current-buffer))
+ (buf (get-buffer-create "*Kill Ring*")))
+ (browse-kill-ring-setup buf (selected-window))
+ (pop-to-buffer buf)
+ (browse-kill-ring-resize-window)
+ nil)))
+
+(provide 'browse-kill-ring)
+
+;;; browse-kill-ring.el ends here
View
69 dot_emacs
@@ -29,8 +29,15 @@
(add-to-list 'load-path "~/src/emacs")
(add-to-list 'load-path "~/src/emacs/color-theme")
+(add-to-list 'load-path "~/src/emacs/expand-region.el")
+(require 'handlebars-mode)
(require 'multi-term)
+(require 'ace-jump-mode)
+(define-key global-map (kbd "C-c SPC") 'ace-jump-mode)
+
+(require 'expand-region)
+(global-set-key (kbd "C-=") 'er/expand-region)
(if window-system
(setq multi-term-program "/bin/zsh")
@@ -187,28 +194,56 @@
;; Flash
(add-to-list 'auto-mode-alist '("\\.as\\'" . js-mode))
+(when (require 'browse-kill-ring nil 'noerror)
+ (browse-kill-ring-default-keybindings))
(add-to-list 'load-path "~/src/edts")
- (require 'edts-start)
+(require 'edts-start)
(edts-man-set-root "~/src/erlang-man/man")
-(setq edts-projects
- '(( ;; My basic project
- (root . "~/src/simple_stuff"))
-;; ( ;; id3as_media
-;; (root . "~/Projects/Arqiva/deps/id3as_media")
+(setq edts-projects
+ '(
+ ( ;; id3as_media (in Arqiva)
+ (root . "~/Projects/Arqiva/deps/id3as_media")
+ (lib-dirs . ("../../deps"))
+ (node-sname . "arqiva_id3as_media")
+ )
+ ( ;; Arqiva
+ (name . "arqiva")
+ (root . "~/Projects/Arqiva")
+ (lib-dirs . ("deps" "apps"))
+ )
+
+ ( ;; id3as_media (in VEE)
+ (root . "~/Projects/VEE/deps/id3as_media")
+ (lib-dirs . ("../../deps"))
+ (node-sname . "vee_id3as_media")
+ )
+ ( ;; VEE
+ (name . "vee")
+ (root . "~/Projects/VEE")
+ (lib-dirs . ("deps" "apps"))
+ )
+
+ ( ;; Calendapp
+ (name . "calendapp")
+ (root . "~/Projects/Calendapp")
+ (lib-dirs . ("deps" "apps"))
+ )
+
+ ( ;; id3as_media (in AEE)
+ (root . "~/Projects/Reuters-Call-Capture/deps/id3as_media")
+ (lib-dirs . ("../../deps"))
+ (node-sname . "aee_id3as_media")
+ )
+;; ( ;; AEE VCI Audio Backup
+;; (root . "~/Projects/Reuters-Call-Capture/apps/vci_audio_backup")
+;; (node-sname . "vci_audio_backup_emacs")
+;; (lib-dirs . ("../../deps" "../../apps"))
;; )
- ( ;; Arqiva
- (name . "arqiva")
- (root . "~/Projects/Arqiva")
+ ( ;; AEE
+ (root . "~/Projects/Reuters-Call-Capture")
(lib-dirs . ("deps" "apps"))
- (node-sname . "arqiva")
- ;; (start-command . "./run.sh")
- )
- ( ;; My other project.
- (name . "other_stuff")
- (root . "~/src/other_stuff")
- (node-sname . "not_as_awesome")
- (lib-dirs . ("lib" "test"))))
)
+ ))
View
3 erlang/erlang-flymake.el
@@ -60,7 +60,8 @@ check on newline and when there are no changes)."
(list (concat (erlang-flymake-get-app-dir) "ebin")))
(defun erlang-flymake-get-include-dirs ()
- (list (concat (erlang-flymake-get-app-dir) "include")))
+ (list (concat (erlang-flymake-get-app-dir) "include")
+ (concat (erlang-flymake-get-app-dir) "deps")))
(defun erlang-flymake-get-app-dir ()
(let ((src-path (file-name-directory (buffer-file-name))))
View
1,267 erlang/erlang-skels-old.el
@@ -0,0 +1,1267 @@
+;;
+;; %CopyrightBegin%
+;;
+;; Copyright Ericsson AB 2010. All Rights Reserved.
+;;
+;; The contents of this file are subject to the Erlang Public License,
+;; Version 1.1, (the "License"); you may not use this file except in
+;; compliance with the License. You should have received a copy of the
+;; Erlang Public License along with this software. If not, it can be
+;; retrieved online at http://www.erlang.org/.
+;;
+;; Software distributed under the License is distributed on an "AS IS"
+;; basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+;; the License for the specific language governing rights and limitations
+;; under the License.
+;;
+;; %CopyrightEnd%
+;;;
+;;; Purpose: Provide Erlang code skeletons.
+;;; See 'erlang-skel-file' variable.
+
+(defvar erlang-tempo-tags nil
+ "Tempo tags for erlang mode")
+
+(defvar erlang-skel
+ '(("If" "if" erlang-skel-if)
+ ("Case" "case" erlang-skel-case)
+ ("Receive" "receive" erlang-skel-receive)
+ ("Receive After" "after" erlang-skel-receive-after)
+ ("Receive Loop" "loop" erlang-skel-receive-loop)
+ ("Module" "module" erlang-skel-module)
+ ("Author" "author" erlang-skel-author)
+ ()
+ ("Small Header" "small-header"
+ erlang-skel-small-header erlang-skel-header)
+ ("Normal Header" "normal-header"
+ erlang-skel-normal-header erlang-skel-header)
+ ("Large Header" "large-header"
+ erlang-skel-large-header erlang-skel-header)
+ ()
+ ("Small Server" "small-server"
+ erlang-skel-small-server erlang-skel-header)
+ ()
+ ("Application" "application"
+ erlang-skel-application erlang-skel-header)
+ ("Supervisor" "supervisor"
+ erlang-skel-supervisor erlang-skel-header)
+ ("supervisor_bridge" "supervisor-bridge"
+ erlang-skel-supervisor-bridge erlang-skel-header)
+ ("gen_server" "generic-server"
+ erlang-skel-generic-server erlang-skel-header)
+ ("gen_event" "gen-event"
+ erlang-skel-gen-event erlang-skel-header)
+ ("gen_fsm" "gen-fsm"
+ erlang-skel-gen-fsm erlang-skel-header)
+ ("Library module" "gen-lib"
+ erlang-skel-lib erlang-skel-header)
+ ("Corba callback" "gen-corba-cb"
+ erlang-skel-corba-callback erlang-skel-header)
+ ("Small Common Test suite" "ct-test-suite-s"
+ erlang-skel-ct-test-suite-s erlang-skel-header)
+ ("Large Common Test suite" "ct-test-suite-l"
+ erlang-skel-ct-test-suite-l erlang-skel-header)
+ ("Erlang TS test suite" "ts-test-suite"
+ erlang-skel-ts-test-suite erlang-skel-header)
+ )
+ "*Description of all skeleton templates.
+Both functions and menu entries will be created.
+
+Each entry in `erlang-skel' should be a list with three or four
+elements, or the empty list.
+
+The first element is the name which shows up in the menu. The second
+is the `tempo' identifier (The string \"erlang-\" will be added in
+front of it). The third is the skeleton descriptor, a variable
+containing `tempo' attributes as described in the function
+`tempo-define-template'. The optional fourth elements denotes a
+function which should be called when the menu is selected.
+
+Functions corresponding to every template will be created. The name
+of the function will be `tempo-template-erlang-X' where `X' is the
+tempo identifier as specified in the second argument of the elements
+in this list.
+
+A list with zero elements means that the a horizontal line should
+be placed in the menu.")
+
+;; In XEmacs `user-mail-address' returns "x@y.z (Foo Bar)" ARGH!
+;; What's wrong with that? RFC 822 says it's legal. [sverkerw]
+;; This needs to use the customized value. If that's not sane, things like
+;; add-log will lose anyhow. Avoid it if there _is_ a paren.
+(defvar erlang-skel-mail-address
+ (if (or (not user-mail-address) (string-match "(" user-mail-address))
+ (concat (user-login-name) "@"
+ (or (and (boundp 'mail-host-address)
+ mail-host-address)
+ (system-name)))
+ user-mail-address)
+ "Mail address of the user.")
+
+;; Expression templates:
+(defvar erlang-skel-case
+ '((erlang-skel-skip-blank) o >
+ "case " p " of" n> p "_ ->" n> p "ok" n> "end" p)
+ "*The skeleton of a `case' expression.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-if
+ '((erlang-skel-skip-blank) o >
+ "if" n> p " ->" n> p "ok" n> "end" p)
+ "The skeleton of an `if' expression.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-receive
+ '((erlang-skel-skip-blank) o >
+ "receive" n> p "_ ->" n> p "ok" n> "end" p)
+ "*The skeleton of a `receive' expression.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-receive-after
+ '((erlang-skel-skip-blank) o >
+ "receive" n> p "_ ->" n> p "ok" n> "after " p "T ->" n>
+ p "ok" n> "end" p)
+ "*The skeleton of a `receive' expression with an `after' clause.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-receive-loop
+ '(& o "loop(" p ") ->" n> "receive" n> p "_ ->" n>
+ "loop(" p ")" n> "end.")
+ "*The skeleton of a simple `receive' loop.
+Please see the function `tempo-define-template'.")
+
+
+;; Attribute templates
+
+(defvar erlang-skel-module
+ '(& "-module("
+ (erlang-add-quotes-if-needed (erlang-get-module-from-file-name))
+ ")." n)
+ "*The skeleton of a `module' attribute.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-author
+ '(& "-author('" erlang-skel-mail-address "')." n)
+ "*The skeleton of a `author' attribute.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-vc nil
+ "*The skeleton template to generate a version control attribute.
+The default is to insert nothing. Example of usage:
+
+ (setq erlang-skel-vc '(& \"-rcs(\\\"$\Id: $ \\\").\") n)
+
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-export
+ '(& "-export([" n> "])." n)
+ "*The skeleton of an `export' attribute.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-import
+ '(& "%%-import(Module, [Function/Arity, ...])." n)
+ "*The skeleton of an `import' attribute.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-compile nil
+ ;; '(& "%%-compile(export_all)." n)
+ "*The skeleton of a `compile' attribute.
+Please see the function `tempo-define-template'.")
+
+
+;; Comment templates.
+
+(defvar erlang-skel-date-function 'erlang-skel-dd-mmm-yyyy
+ "*Function which returns date string.
+Look in the module `time-stamp' for a battery of functions.")
+
+(defvar erlang-skel-copyright-comment '()
+ "*The template for a copyright line in the header, normally empty.
+This variable should be bound to a `tempo' template, for example:
+ '(& \"%%% Copyright (C) 2000, Yoyodyne, Inc.\" n)
+
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-created-comment
+ '(& "%%% Created : " (funcall erlang-skel-date-function) " by "
+ (user-full-name) " <" erlang-skel-mail-address ">" n)
+ "*The template for the \"Created:\" comment line.")
+
+(defvar erlang-skel-author-comment
+ '(& "%%% Author : " (user-full-name) " <" erlang-skel-mail-address ">" n)
+ "*The template for creating the \"Author:\" line in the header.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-file-comment
+ '(& "%%% File : " (file-name-nondirectory buffer-file-name) n)
+"*The template for creating the \"Module:\" line in the header.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-small-header
+ '(o (erlang-skel-include erlang-skel-module)
+ ;; erlang-skel-author)
+ n
+ (erlang-skel-include erlang-skel-compile
+ ;; erlang-skel-export
+ erlang-skel-vc))
+ "*The template of a small header without any comments.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-normal-header
+ '(o (erlang-skel-include erlang-skel-copyright-comment
+ erlang-skel-file-comment
+ erlang-skel-author-comment)
+ "%%% Description : " p n
+ (erlang-skel-include erlang-skel-created-comment) n
+ (erlang-skel-include erlang-skel-small-header) n)
+ "*The template of a normal header.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-large-header
+ '(o (erlang-skel-separator)
+ (erlang-skel-include erlang-skel-copyright-comment
+ erlang-skel-file-comment
+ erlang-skel-author-comment)
+ "%%% Description : " p n
+ "%%%" n
+ (erlang-skel-include erlang-skel-created-comment)
+ (erlang-skel-separator)
+ (erlang-skel-include erlang-skel-small-header) )
+ "*The template of a large header.
+Please see the function `tempo-define-template'.")
+
+
+;; Server templates.
+
+(defvar erlang-skel-small-server
+ '((erlang-skel-include erlang-skel-large-header)
+ "-export([start/0,init/1])." n n n
+ "start() ->" n> "spawn(" (erlang-get-module-from-file-name)
+ ", init, [self()])." n n
+ "init(From) ->" n>
+ "loop(From)." n n
+ "loop(From) ->" n>
+ "receive" n>
+ p "_ ->" n>
+ "loop(From)" n>
+ "end."
+ )
+ "*Template of a small server.
+Please see the function `tempo-define-template'.")
+
+;; Behaviour templates.
+
+(defvar erlang-skel-application
+ '((erlang-skel-include erlang-skel-large-header)
+ "-behaviour(application)." n n
+ "%% Application callbacks" n
+ "-export([start/2, stop/1])." n n
+ (erlang-skel-double-separator 2)
+ "%% Application callbacks" n
+ (erlang-skel-double-separator 2)
+ (erlang-skel-separator 2)
+ "%% Function: start(Type, StartArgs) -> {ok, Pid} |" n
+ "%% {ok, Pid, State} |" n
+ "%% {error, Reason}" n
+ "%% Description: This function is called whenever an application " n
+ "%% is started using application:start/1,2, and should start the processes" n
+ "%% of the application. If the application is structured according to the" n
+ "%% OTP design principles as a supervision tree, this means starting the" n
+ "%% top supervisor of the tree." n
+ (erlang-skel-separator 2)
+ "start(_Type, StartArgs) ->" n>
+ "case 'TopSupervisor':start_link(StartArgs) of" n>
+ "{ok, Pid} -> " n>
+ "{ok, Pid};" n>
+ "Error ->" n>
+ "Error" n>
+ "end." n
+ n
+ (erlang-skel-separator 2)
+ "%% Function: stop(State) -> void()" n
+ "%% Description: This function is called whenever an application" n
+ "%% has stopped. It is intended to be the opposite of Module:start/2 and" n
+ "%% should do any necessary cleaning up. The return value is ignored. "n
+ (erlang-skel-separator 2)
+ "stop(_State) ->" n>
+ "ok." n
+ n
+ (erlang-skel-double-separator 2)
+ "%% Internal functions" n
+ (erlang-skel-double-separator 2)
+ )
+ "*The template of an application behaviour.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-supervisor
+ '((erlang-skel-include erlang-skel-large-header)
+ "-behaviour(supervisor)." n n