diff --git a/e/divers-el/els/boxquote.el b/e/divers-el/els/boxquote.el new file mode 100644 index 00000000..5c77790f --- /dev/null +++ b/e/divers-el/els/boxquote.el @@ -0,0 +1,585 @@ +;;; boxquote.el --- Quote text with a semi-box. +;; Copyright 1999-2009 by Dave Pearson +;; $Revision: 1.23 $ + +;; boxquote.el is free software distributed under the terms of the GNU +;; General Public Licence, version 2 or (at your option) any later version. +;; For details see the file COPYING. + +;;; Commentary: + +;; boxquote provides a set of functions for using a text quoting style that +;; partially boxes in the left hand side of an area of text, such a marking +;; style might be used to show externally included text or example code. +;; +;; ,---- +;; | The default style looks like this. +;; `---- +;; +;; A number of functions are provided for quoting a region, a buffer, a +;; paragraph and a defun. There are also functions for quoting text while +;; pulling it in, either by inserting the contents of another file or by +;; yanking text into the current buffer. +;; +;; The latest version of boxquote.el can be found at: +;; +;; + +;;; Thanks: + +;; Kai Grossjohann for inspiring the idea of boxquote. I wrote this code to +;; mimic the "inclusion quoting" style in his Usenet posts. I could have +;; hassled him for his code but it was far more fun to write it myself. +;; +;; Mark Milhollan for providing a patch that helped me get the help quoting +;; functions working with XEmacs. +;; +;; Oliver Much for suggesting the idea of having a `boxquote-kill-ring-save' +;; function. +;; +;; Reiner Steib for suggesting `boxquote-where-is' and the idea of letting +;; `boxquote-describe-key' describe key bindings from other buffers. Also +;; thanks go to Reiner for suggesting `boxquote-insert-buffer'. + +;;; Code: + +;; Things we need: + +(eval-when-compile + (require 'cl)) +(require 'rect) + +;; Attempt to handle older/other emacs. +(eval-and-compile + + ;; If customize isn't available just use defvar instead. + (unless (fboundp 'defgroup) + (defmacro defgroup (&rest rest) nil) + (defmacro defcustom (symbol init docstring &rest rest) + `(defvar ,symbol ,init ,docstring))) + + ;; If `line-beginning-position' isn't available provide one. + (unless (fboundp 'line-beginning-position) + (defun line-beginning-position (&optional n) + "Return the `point' of the beginning of the current line." + (save-excursion + (beginning-of-line n) + (point)))) + + ;; If `line-end-position' isn't available provide one. + (unless (fboundp 'line-end-position) + (defun line-end-position (&optional n) + "Return the `point' of the end of the current line." + (save-excursion + (end-of-line n) + (point))))) + +;; Customize options. + +(defgroup boxquote nil + "Mark regions of text with a half-box." + :group 'editing + :prefix "boxquote-") + +(defcustom boxquote-top-and-tail "----" + "*Text that will be used at the top and tail of the box." + :type 'string + :group 'boxquote) + +(defcustom boxquote-top-corner "," + "*Text used for the top corner of the box." + :type 'string + :group 'boxquote) + +(defcustom boxquote-bottom-corner "`" + "*Text used for the bottom corner of the box." + :type 'string + :group 'boxquote) + +(defcustom boxquote-side "| " + "*Text used for the side of the box." + :type 'string + :group 'boxquote) + +(defcustom boxquote-title-format "[ %s ]" + "*Format string to use when creating a box title." + :type 'string + :group 'boxquote) + +(defcustom boxquote-title-files t + "*Should a `boxquote-insert-file' title the box with the file name?" + :type '(choice + (const :tag "Title the box with the file name" t) + (const :tag "Don't title the box with the file name" nil)) + :group 'boxquote) + +(defcustom boxquote-file-title-function #'file-name-nondirectory + "*Function to apply to a file's name when using it to title a box." + :type 'function + :group 'boxquote) + +(defcustom boxquote-title-buffers t + "*Should a `boxquote-insert-buffer' title the box with the buffer name?" + :type '(choice + (const :tag "Title the box with the buffer name" t) + (const :tag "Don't title the box with the buffer name" nil)) + :group 'boxquote) + +(defcustom boxquote-buffer-title-function #'identity + "*Function to apply to a buffer's name when using it to title a box." + :type 'function + :group 'boxquote) + +(defcustom boxquote-region-hook nil + "*Hooks to perform when on a region prior to boxquoting. + +Note that all forms of boxquoting use `boxquote-region' to create the +boxquote. Because of this any hook you place here will be invoked by any of +the boxquoting functions." + :type 'hook + :group 'boxquote) + +(defcustom boxquote-yank-hook nil + "*Hooks to perform on the yanked text prior to boxquoting." + :type 'hook + :group 'boxquote) + +(defcustom boxquote-insert-file-hook nil + "*Hooks to perform on the text from an inserted file prior to boxquoting." + :type 'hook + :group 'boxquote) + +(defcustom boxquote-kill-ring-save-title #'buffer-name + "*Function for working out the title for a `boxquote-kill-ring-save'. + +The string returned from this function will be used as the title for a +boxquote when the saved text is yanked into a buffer with \\[boxquote-yank]. + +An example of a non-trivial value for this variable might be: + + (lambda () + (if (string= mode-name \"Article\") + (aref gnus-current-headers 4) + (buffer-name))) + +In this case, if you are a `gnus' user, \\[boxquote-kill-ring-save] could be +used to copy text from an article buffer and, when it is yanked into another +buffer using \\[boxquote-yank], the title of the boxquote would be the ID of +the article you'd copied the text from." + :type 'function + :group 'boxquote) + +(defcustom boxquote-describe-function-title-format "C-h f %s RET" + "*Format string to use when formatting a function description box title" + :type 'string + :group 'boxquote) + +(defcustom boxquote-describe-variable-title-format "C-h v %s RET" + "*Format string to use when formatting a variable description box title" + :type 'string + :group 'boxquote) + +(defcustom boxquote-describe-key-title-format "C-h k %s" + "*Format string to use when formatting a key description box title" + :type 'string + :group 'boxquote) + +(defcustom boxquote-where-is-title-format "C-h w %s RET" + "*Format string to use when formatting a `where-is' description box title" + :type 'string + :group 'boxquote) + +(defcustom boxquote-where-is-body-format "%s is on %s" + "*Format string to use when formatting a `where-is' description." + :type 'string + :group 'boxquote) + +;; Main code: + +(defun boxquote-xemacs-p () + "Are we running in XEmacs?" + (and (boundp 'running-xemacs) (symbol-value 'running-xemacs))) + +(defun boxquote-points () + "Find the start and end points of a boxquote. + +If `point' is inside a boxquote then a cons is returned, the `car' is the +start `point' and the `cdr' is the end `point'. NIL is returned if no +boxquote is found." + (save-excursion + (beginning-of-line) + (let* ((re-top (concat "^" (regexp-quote boxquote-top-corner) + (regexp-quote boxquote-top-and-tail))) + (re-left (concat "^" (regexp-quote boxquote-side))) + (re-bottom (concat "^" (regexp-quote boxquote-bottom-corner) + (regexp-quote boxquote-top-and-tail))) + (points + (flet ((find-box-end (re &optional back) + (save-excursion + (when (if back + (search-backward-regexp re nil t) + (search-forward-regexp re nil t)) + (point))))) + (cond ((looking-at re-top) + (cons (point) (find-box-end re-bottom))) + ((looking-at re-left) + (cons (find-box-end re-top t) (find-box-end re-bottom))) + ((looking-at re-bottom) + (cons (find-box-end re-top t) (line-end-position))))))) + (when (and (car points) (cdr points)) + points)))) + +(defun boxquote-quoted-p () + "Is `point' inside a boxquote?" + (not (null (boxquote-points)))) + +(defun boxquote-points-with-check () + "Get the `boxquote-points' and flag an error of no box was found." + (or (boxquote-points) (error "I can't see a box here"))) + +(defun boxquote-title-format-as-regexp () + "Return a regular expression to match the title." + (with-temp-buffer + (insert (regexp-quote boxquote-title-format)) + (setf (point) (point-min)) + (when (search-forward "%s" nil t) + (replace-match ".*" nil t)) + (buffer-string))) + +(defun boxquote-get-title () + "Get the title for the current boxquote." + (multiple-value-bind (prefix-len suffix-len) + (with-temp-buffer + (let ((look-for "%s")) + (insert boxquote-title-format) + (setf (point) (point-min)) + (search-forward look-for) + (list (- (point) (length look-for) 1) (- (point-max) (point))))) + (save-excursion + (save-restriction + (boxquote-narrow-to-boxquote) + (setf (point) (+ (point-min) + (length (concat boxquote-top-corner + boxquote-top-and-tail)))) + (if (looking-at (boxquote-title-format-as-regexp)) + (buffer-substring-no-properties (+ (point) prefix-len) + (- (line-end-position) suffix-len)) + ""))))) + +;;;###autoload +(defun boxquote-title (title) + "Set the title of the current boxquote to TITLE. + +If TITLE is an empty string the title is removed. Note that the title will +be formatted using `boxquote-title-format'." + (interactive (list (read-from-minibuffer "Title: " (boxquote-get-title)))) + (save-excursion + (save-restriction + (boxquote-narrow-to-boxquote) + (setf (point) (+ (point-min) + (length (concat boxquote-top-corner + boxquote-top-and-tail)))) + (unless (eolp) + (kill-line)) + (unless (zerop (length title)) + (insert (format boxquote-title-format title)))))) + +;;;###autoload +(defun boxquote-region (start end) + "Draw a box around the left hand side of a region bounding START and END." + (interactive "r") + (save-excursion + (save-restriction + (flet ((bol-at-p (n) + (setf (point) n) + (bolp)) + (insert-corner (corner pre-break) + (insert (concat (if pre-break "\n" "") + corner boxquote-top-and-tail "\n")))) + (let ((break-start (not (bol-at-p start))) + (break-end (not (bol-at-p end)))) + (narrow-to-region start end) + (run-hooks 'boxquote-region-hook) + (setf (point) (point-min)) + (insert-corner boxquote-top-corner break-start) + (let ((start-point (line-beginning-position))) + (setf (point) (point-max)) + (insert-corner boxquote-bottom-corner break-end) + (string-rectangle start-point + (progn + (setf (point) (point-max)) + (forward-line -2) + (line-beginning-position)) + boxquote-side))))))) + +;;;###autoload +(defun boxquote-buffer () + "Apply `boxquote-region' to a whole buffer." + (interactive) + (boxquote-region (point-min) (point-max))) + +;;;###autoload +(defun boxquote-insert-file (filename) + "Insert the contents of a file, boxed with `boxquote-region'. + +If `boxquote-title-files' is non-nil the boxquote will be given a title that +is the result of applying `boxquote-file-title-function' to FILENAME." + (interactive "fInsert file: ") + (insert (with-temp-buffer + (insert-file-contents filename nil) + (run-hooks 'boxquote-insert-file-hook) + (boxquote-buffer) + (when boxquote-title-files + (boxquote-title (funcall boxquote-file-title-function filename))) + (buffer-string)))) + +;;;###autoload +(defun boxquote-insert-buffer (buffer) + "Insert the contents of a buffer, boxes with `boxquote-region'. + +If `boxquote-title-buffers' is non-nil the boxquote will be given a title that +is the result of applying `boxquote-buffer-title-function' to BUFFER." + (interactive "bInsert Buffer: ") + (boxquote-text + (with-current-buffer buffer + (buffer-substring-no-properties (point-min) (point-max)))) + (when boxquote-title-buffers + (boxquote-title (funcall boxquote-buffer-title-function buffer)))) + +;;;###autoload +(defun boxquote-kill-ring-save () + "Like `kill-ring-save' but remembers a title if possible. + +The title is acquired by calling `boxquote-kill-ring-save-title'. The title +will be used by `boxquote-yank'." + (interactive) + (call-interactively #'kill-ring-save) + (setf (car kill-ring-yank-pointer) + (format "%S" (list + 'boxquote-yank-marker + (funcall boxquote-kill-ring-save-title) + (car kill-ring-yank-pointer))))) + +;;;###autoload +(defun boxquote-yank () + "Do a `yank' and box it in with `boxquote-region'. + +If the yanked entry was placed on the kill ring with +`boxquote-kill-ring-save' the resulting boxquote will be titled with +whatever `boxquote-kill-ring-save-title' returned at the time." + (interactive) + (save-excursion + (insert (with-temp-buffer + (yank) + (setf (point) (point-min)) + (let ((title + (let ((yanked (condition-case nil + (read (current-buffer)) + (error nil)))) + (when (listp yanked) + (when (eq (car yanked) 'boxquote-yank-marker) + (setf (buffer-string) (nth 2 yanked)) + (nth 1 yanked)))))) + (run-hooks 'boxquote-yank-hook) + (boxquote-buffer) + (when title + (boxquote-title title)) + (buffer-string)))))) + +;;;###autoload +(defun boxquote-defun () + "Apply `boxquote-region' the current defun." + (interactive) + (mark-defun) + (boxquote-region (region-beginning) (region-end))) + +;;;###autoload +(defun boxquote-paragraph () + "Apply `boxquote-region' to the current paragraph." + (interactive) + (mark-paragraph) + (boxquote-region (region-beginning) (region-end))) + +;;;###autoload +(defun boxquote-boxquote () + "Apply `boxquote-region' to the current boxquote." + (interactive) + (let ((box (boxquote-points-with-check))) + (boxquote-region (car box) (1+ (cdr box))))) + +(defun boxquote-help-buffer-name (item) + "Return the name of the help buffer associated with ITEM." + (if (boxquote-xemacs-p) + (loop for buffer in (symbol-value 'help-buffer-list) + when (string-match (concat "^*Help:.*`" item "'") buffer) + return buffer) + "*Help*")) + +(defun boxquote-quote-help-buffer (help-call title-format item) + "Perform a help command and boxquote the output. + +HELP-CALL is a function that calls the help command. + +TITLE-FORMAT is the `format' string to use to product the boxquote title. + +ITEM is a function for retrieving the item to get help on." + (let ((one-window-p (one-window-p))) + (boxquote-text + (save-window-excursion + (funcall help-call) + (with-current-buffer (boxquote-help-buffer-name (funcall item)) + (buffer-substring-no-properties (point-min) (point-max))))) + (boxquote-title (format title-format (funcall item))) + (when one-window-p + (delete-other-windows)))) + +;;;###autoload +(defun boxquote-describe-function () + "Call `describe-function' and boxquote the output into the current buffer." + (interactive) + (boxquote-quote-help-buffer + #'(lambda () + (call-interactively #'describe-function)) + boxquote-describe-function-title-format + #'(lambda () + (car (if (boxquote-xemacs-p) + (symbol-value 'function-history) + minibuffer-history))))) + +;;;###autoload +(defun boxquote-describe-variable () + "Call `describe-variable' and boxquote the output into the current buffer." + (interactive) + (boxquote-quote-help-buffer + #'(lambda () + (call-interactively #'describe-variable)) + boxquote-describe-variable-title-format + #'(lambda () + (car (if (boxquote-xemacs-p) + (symbol-value 'variable-history) + minibuffer-history))))) + +;;;###autoload +(defun boxquote-describe-key (key) + "Call `describe-key' and boxquote the output into the current buffer. + +If the call to this command is prefixed with \\[universal-argument] you will also be +prompted for a buffer. The key defintion used will be taken from that buffer." + (interactive "kDescribe key: ") + (let ((from-buffer (if current-prefix-arg + (read-buffer "Buffer: " (current-buffer) t) + (current-buffer)))) + (let ((binding + (with-current-buffer from-buffer + (key-binding key)))) + (if (or (null binding) (integerp binding)) + (message "%s is undefined" (with-current-buffer from-buffer + (key-description key))) + (boxquote-quote-help-buffer + #'(lambda () + (with-current-buffer from-buffer + (describe-key key))) + boxquote-describe-key-title-format + #'(lambda () + (with-current-buffer from-buffer + (key-description key)))))))) + +;;;###autoload +(defun boxquote-shell-command (command) + "Call `shell-command' with COMMAND and boxquote the output." + (interactive (list (read-from-minibuffer "Shell command: " nil nil nil 'shell-command-history))) + (boxquote-text (with-temp-buffer + (shell-command command t) + (buffer-string))) + (boxquote-title command)) + +;;;###autoload +(defun boxquote-where-is (definition) + "Call `where-is' with DEFINITION and boxquote the result." + (interactive "CCommand: ") + (boxquote-text (with-temp-buffer + (where-is definition t) + (format boxquote-where-is-body-format definition (buffer-string)))) + (boxquote-title (format boxquote-where-is-title-format definition))) + +;;;###autoload +(defun boxquote-text (text) + "Insert TEXT, boxquoted." + (interactive "sText: ") + (save-excursion + (unless (bolp) + (insert "\n")) + (insert + (with-temp-buffer + (insert text) + (boxquote-buffer) + (buffer-string))))) + +;;;###autoload +(defun boxquote-narrow-to-boxquote () + "Narrow the buffer to the current boxquote." + (interactive) + (let ((box (boxquote-points-with-check))) + (narrow-to-region (car box) (cdr box)))) + +;;;###autoload +(defun boxquote-narrow-to-boxquote-content () + "Narrow the buffer to the content of the current boxquote." + (interactive) + (let ((box (boxquote-points-with-check))) + (narrow-to-region (save-excursion + (setf (point) (car box)) + (forward-line 1) + (point)) + (save-excursion + (setf (point) (cdr box)) + (line-beginning-position))))) + +;;;###autoload +(defun boxquote-kill () + "Kill the boxquote and its contents." + (interactive) + (let ((box (boxquote-points-with-check))) + (kill-region (car box) (1+ (cdr box))))) + +;;;###autoload +(defun boxquote-fill-paragraph (arg) + "Perform a `fill-paragraph' inside a boxquote." + (interactive "P") + (if (boxquote-quoted-p) + (save-restriction + (boxquote-narrow-to-boxquote-content) + (let ((fill-prefix boxquote-side)) + (fill-paragraph arg))) + (fill-paragraph arg))) + +;;;###autoload +(defun boxquote-unbox-region (start end) + "Remove a box created with `boxquote-region'." + (interactive "r") + (save-excursion + (save-restriction + (narrow-to-region start end) + (setf (point) (point-min)) + (if (looking-at (concat "^" (regexp-quote boxquote-top-corner) + (regexp-quote boxquote-top-and-tail))) + (let ((ends (concat "^[" (regexp-quote boxquote-top-corner) + (regexp-quote boxquote-bottom-corner) + "]" boxquote-top-and-tail)) + (lines (concat "^" (regexp-quote boxquote-side)))) + (loop while (< (point) (point-max)) + if (looking-at ends) do (kill-line t) + if (looking-at lines) do (delete-char 2) + do (forward-line))) + (error "I can't see a box here"))))) + +;;;###autoload +(defun boxquote-unbox () + "Remove the boxquote that contains `point'." + (interactive) + (let ((box (boxquote-points-with-check))) + (boxquote-unbox-region (car box) (1+ (cdr box))))) + +(provide 'boxquote) + +;;; boxquote.el ends here. diff --git a/e/divers-el/els/parenface.el b/e/divers-el/els/parenface.el new file mode 100644 index 00000000..0fb91f64 --- /dev/null +++ b/e/divers-el/els/parenface.el @@ -0,0 +1,38 @@ +;;; parenface.el --- Provide a face for parens in lisp modes. +;; By Dave Pearson +;; $Revision: 1.1 $ + +;; Add a paren-face to emacs and add support for it to the various lisp modes. +;; +;; Based on some code that Boris Schaefer posted +;; to comp.lang.scheme in message <87hf8g9nw5.fsf@qiwi.uncommon-sense.net>. + +(defvar paren-face 'paren-face) + +(defface paren-face + '((((class color)) + (:foreground "DimGray"))) + "Face for displaying a paren." + :group 'faces) + +(defmacro paren-face-add-support (keywords) + "Generate a lambda expression for use in a hook." + `(lambda () + (let* ((regexp "(\\|)") + (match (assoc regexp ,keywords))) + (unless (eq (cdr match) paren-face) + (setq ,keywords (append (list (cons regexp paren-face)) ,keywords)))))) + +;; Keep the compiler quiet. +(eval-when-compile + (defvar scheme-font-lock-keywords-2 nil) + (defvar lisp-font-lock-keywords-2 nil)) + +(add-hook 'scheme-mode-hook (paren-face-add-support scheme-font-lock-keywords-2)) +(add-hook 'lisp-mode-hook (paren-face-add-support lisp-font-lock-keywords-2)) +(add-hook 'emacs-lisp-mode-hook (paren-face-add-support lisp-font-lock-keywords-2)) +(add-hook 'lisp-interaction-mode-hook (paren-face-add-support lisp-font-lock-keywords-2)) + +(provide 'parenface) + +;; parenface.el ends here