Dave + Emacs Maintainers, It would be nice if boxquote be made available via GNU ELPA.
TIA, Jambunathan K. Dave Pearson <[email protected]> writes: > Added a function for inserting the contents of another buffer based on a > suggestion by Reiner Steib. > > -- cut here ---------------------------------------------------------------- > ;;; boxquote.el --- Quote text with a semi-box. > ;; Copyright 1999-2008 by Dave Pearson <[email protected]> > ;; $Revision: 1.21 $ > > ;; 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: > ;; > ;; <URL:http://www.davep.org/emacs/#boxquote.el> > > ;;; 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-bugger' 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-string)))) > (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. > -- cut here ---------------------------------------------------------------- _______________________________________________ gnu-emacs-sources mailing list [email protected] https://lists.gnu.org/mailman/listinfo/gnu-emacs-sources
