From: Don Armstrong Date: Mon, 7 Jan 2013 23:53:22 +0000 (-0800) Subject: ditch tiny-tools to migrate to submodule X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=a2b37e32ef01f52bc82f55dcbe9f0ac8cc26e895;p=lib.git ditch tiny-tools to migrate to submodule --- diff --git a/emacs_el/tiny-tools/other/c-comment-edit2.el b/emacs_el/tiny-tools/other/c-comment-edit2.el deleted file mode 100644 index bb4824a..0000000 --- a/emacs_el/tiny-tools/other/c-comment-edit2.el +++ /dev/null @@ -1,853 +0,0 @@ -;;; c-comment-edit2.el --- C Comment Edit - -;; This file is not part of Emacs - -;; Copyright (C) 1987 Kyle Jones -;; Author: Kyle Jones -;; Maintainer: Jari Aalto -;; Keywords: extensions - -;;{{{ id - -;; COPYRIGHT NOTICE -;; -;; This program is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by the Free -;; Software Foundation; either version 2 of the License, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -;; for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with program; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. -;; -;; Visit for more information - -;;}}} -;;{{{ Docs - -;; .................................................. &t-documentation ... - -;;; Commentary: - -;; -;; Date: 12 Jan 89 17:36:19 GMT -;; -;; Attached is an enhanced version of the `c-comment-edit' package, last -;; posted sometime in 1987. -;; -;; c-comment-edit is a command that copies a C comment into a -;; temporary buffer for editing under a more suitable major mode -;; (usually text-mode). Once the comment is edited, -;; c-comment-edit-end (normally bound to C-c ESC) replaces the old -;; comment with the edited version, adding comment delimiters and -;; leaders as necessary. c-comment-edit is ideal for large comments -;; of these styles: -;; -;; /* /* /* -;; ... * ... ** ... -;; ... * ... ** ... -;; */ */ */ -;; -;; Features added: -;; -;; o c-comment-edit no longer uses a recursive-edit so multiple -;; c-comment-edit's be running simultaneously. -;; o c-comment-edit will now search forward from point for a comment if -;; point is not within a comment. -;; o c-comment-edit-hook is provided. -;; o Bill Carpenter's c-comment-leader-regexp fixed was incorporated. -;; -;; Kyle Jones - -;;}}} -;;{{{ history - -;; ......................................................... &t-history ... -;;; Change Log: -;; -;; Mar 03 2001 [jari] 20.7 v1.18 Released -;; - Added ###autoload items. -;; -;; Mar 23 1998 [jari] 19.34 v1.12 Released -;; - Byte compile errors fixed. -;; -;; Aug 11 1997 [jari] 19.28 v1.11 Released -;; - The example setup at the end worked fine, execept if used inside -;; the function. The last line was not adjusted to -;; -;; ***********/ but to ********* -;; */ -;; -;; That is; the last */ was not shifted to the end of line. -;; - corrected the example. -;; -;; Feb 24 1997 [jari] 19.28 v1.10 Released -;; - Rick Flower reported that c-indent-command -;; wasn't seen by 19.15 byte compiler. Now requires cc-mode. -;; -;; Feb 26 1997 [jari] 19.28 v1.9 Released -;; - Small error in window configuration restore corrected. -;; -;; Dec 11 1996 [jari] 19.28 v1.6-1.8 Released -;; - Some minor byte compilation corrections. Window configuration -;; bug corrected. c-comment-edit-at-point corrected in C++ mode. -;; -;; May 27 1996 [jari] 19.28 v1.5 Released -;; - Added saving/restoring the frame configuration. Previously the -;; window layout was destroyed when the c-comment-edit-end was -;; finished. Now windows are restored as they were. -;; - Made this package 18.xx compatible again. -;; -;; Apr 30 1996 [jari] 19.28 v1.4 Released -;; - Jerome Santini reported problems -;; in 19.30 with the font-lock code. Now the eval-when-compile -;; forms take in effect only if font-lock is not present. This was -;; serious bug. -;; - Renamed all the rest functions to have prefix "c-comment". This -;; follows the GNU package guidelines. -;; - Added defontifying a comment in separate buffer to get clear look. -;; -;; Oct 14 1995 [jari] 19.28 v1.3 Released -;; - Corrected the LCD entry, that was mistakenly modified. -;; -;; Sep 8 1995 [jari] 19.28 v1.2 NotReleased -;; - Cleaned up the Newsereader headers and presedved only 'date:' -;; of original introduction -;; within-c-comment-p :! renamed to comment-area, more general -;; - Added new function c-comment-edit-at-point. If point is inside of a -;; comment, the comment is edited. Otherwise, a new comment is created -;; at point. [jcolman] -;; - Cleared byte-compiler errors. Added optional parameters to main function -;; c-comment-edit. Main also now returns more gracefully, if comment -;; syntax isn't defined. This really should be made more general.. -;; -;; Sep 4 1995 [jari] 19.28 v1.1 NotReleased -;; - Jake Colman sent mail asking to crrect some -;; things. Great that I get user feedback! -;; - kill-all-local-variables call removed -;; - renamed c-comment-edit-after-hook --> c-comment-edit-exit-hook -;; and moved it to the end of defun. -;; - The fill-column setting has been adjusted to include "/*" (-2 from the -;; original setting). -;; - When edited comment is inserted back, the colors are gone. This has been -;; corrected to re-fontify the comment if font-lock-mode is on. -;; - Added c-comment-edit-load-hook -;; -;; Apr 28 1995 [jari] 19.28 v0.2 NotReleased -;; - After talking with Kyle directly, he said that I should load -;; this .el with some other name, because he didn't plan to have -;; any enhancement support. He said that I had been among the very -;; few that had ever asked any changes to this module. -;; - On my behalf, since this is almost identical copy of the -;; original, I have no objections that someone else modifies this -;; .el with the "c-comment-edit2.el" -- I do plan to update this if it has -;; errors that are caused by me of course, but right now I don't -;; think it misses anything crucial. Just drop me a note, I love to hear -;; about new improvements. -;; -;; Feb 22 1995 [jari] 19.28 v0.1 NotReleased -;; - I had used this intensively when 18.57 was still around in our -;; envinronment (about 4 moths ago), but when I moved to 19.28 -;; I found some incompatibilities in keybindings and I dislike the -;; comment syntax which left first line empty. Now there is variable -;; to configure 1st line layout. -;; - Now ESC ESC terminates in 19 and ESC in 18. -;; - Added few confortable variables -;; * c-comment-edit-bname , c-comment-edit-empty-1-line -;; * c-comment-edit-other-buffer , c-comment-edit-C-buf -;; * c-comment-edit-[bc,ec] -;; - Added hooks -;; * c-comment-edit-end-hook -;; * c-comment-edit-after-hook -;; -;; - touched original code: -;; * c-comment-edit -;; - there was one problem with this, the hook was too early -;; run compared to kill-local-var, so if you turned on some minor -;; mode, it was effectively lost. --> now the hook runs last. -;; * c-comment-edit-end -;; - Added the new functionality here, many changes, sets global -;; variables + runs hooks -;; -;; - There is an EXAMPLE section at the end of this file which is one of -;; my favourite C/C++ function header. And cleanup function to -;; retain the format after comment has been added too. - -;;}}} - -;;{{{ setup: bind, hooks - -;;; Code: - -(require 'cc-mode) -(load "c-mode" 'noerr) ;Hm, XEmacs 19.13 lacks this? -(eval-when-compile (require 'cl)) - -;;; .......................................................... &v-bind ... - -(defvar c-com-mode-map nil "C comment edit map") - -(if c-com-mode-map - nil - (setq c-com-mode-map (make-sparse-keymap)) - ;; keys; - (if (string< emacs-version "19") - (progn - (define-key c-com-mode-map "\C-c\C-c" 'c-comment-edit-end) - (define-key c-com-mode-map "\e" 'c-comment-edit-abort)) - (define-key c-com-mode-map "\C-c\C-c" 'c-comment-edit-end) - (define-key c-com-mode-map "\e\e" 'c-comment-edit-abort))) - -;;; ......................................................... &v-hooks ... - -(defvar c-comment-edit-hook nil - "*Function to call whenever `c-comment-edit' is used. -The function is called just before the `c-comment-edit' function allows you to -begin editing the comment.") - -(defvar c-comment-edit-exit-hook nil - "*Enables you to do some cleanup after edit is done, not called -if user aborted the action. Buffer is already inserted back when this -hook is called.") - -(defvar c-comment-edit-end-hook nil - "*When user has pressed C-c or ESC to complete editing, the -Comment prefix lines are drawn. After it has completed drawing, -and the buffer is in ready to be inserted back, this hook will be called. ") - -(defvar c-comment-edit-load-hook nil - "*Run when file has been loaded.") - -;;}}} -;;{{{ setup: read-only vars - -;;; ....................................................... &v-private ... -;;; These are set by funcs, user can check the values in hooks. - -(defconst c-comment-edit-beg-c nil - "After the comment is edited, this variable contains -begin MARK of comment.") - -(defconst c-comment-edit-end-c nil - "After the comment is edited, this variable contains -end MARK of comment.") - -(defconst c-comment-edit-bufc nil - "After the comment is edited, this variable contains C-code buffer name, -where comment edited belonged.") - -;;}}} -;;{{{ setup: -- user config - -;;; .......................................................... &v-conf ... - -(defvar c-comment-window-register ?w - "*Which register to use to save window configuration.") - -;;;###autoload -(defvar c-comment-leader " *" - "*Leader used when rebuilding edited C comments. The value of this variable -should be a two-character string. Values of \" \", \" *\" and \"**\" -produce the comment styles: - /* /* /* - ... * ... ** ... - ... * ... ** ... - */ */ */ -respectively.") - -(defconst c-comment-leader-regexp "^[ ]*\\(\\*\\*\\|\\*\\)?[ ]?" - "Regexp used to match C comment leaders.") - -(defvar c-comment-edit-mode 'text-mode - "*Major mode used by `c-comment-edit' when editing C comments.") - -(defvar c-comment-edit-buffer-alist nil - "Assoc list of C buffers and their associated comment buffers. -Elements are of the form (C-BUFFER COMMENT-BUFFER COMMENT-START COMMENT-END) -COMMENT-START and COMMENT-END are markers in the C-BUFFER.") - -(defvar c-comment-edit-bname " *C Comment Edit*" - "*buffer name to edit the comment") - -(defvar c-comment-edit-empty-1-line nil - "*This determines if the first comment line will be left empty - -/* - * comment begin, when value is t - */ -") - -(defvar c-comment-edit-other-buffer t - "*Set to nil if you want to edit in full buffer") - -;;}}} -;;{{{ code: macros - -;;; ########################################################## &Macros ### - -(defmacro c-comment-save-point (&rest body) - "Save value of point, evalutes FORMS and restore value of point. -If the saved value of point is no longer valid go to (point-max). -The variable `save-point' is lambda-bound to the value of point for -the duration of this call." - (list 'let '((save-point (point))) - (list 'unwind-protect - (cons 'progn body) - '(goto-char (min (point-max) save-point))))) - -(defmacro c-comment-marker (pos &optional buffer) - (list 'set-marker '(make-marker) pos buffer)) - -;;}}} - -;;; ########################################################### &Funcs ### - -;;{{{ code: general - -;;; ---------------------------------------------------------------------- -;;; -(defun c-comment-save-state () - "Save window configuration." - (if (fboundp 'point-to-register-compatibility-binding) - (funcall - (symbol-function 'point-to-register-compatibility-binding) - c-comment-window-register - 'window-config))) - -;;; ---------------------------------------------------------------------- -;;; -(defun c-comment-restore-state () - "Save window configuration." - (if (and c-comment-window-register - (get-register c-comment-window-register) - (fboundp 'jump-to-register-compatibility-binding)) - (funcall - (symbol-function 'jump-to-register-compatibility-binding) - c-comment-window-register))) - -;;; ---------------------------------------------------------------------- -;;; -(defun c-comment-area (beg end) - "Searches area bounds delimited by strings BEG and END. -First searches backward, them forward. - -Returns: - (beg-point . end-point) - nil." - (condition-case nil - (let (p pp) - (c-comment-save-point - (search-backward beg) - (setq p (point)) - (search-forward end) - (setq pp (point))) - (if (< (point) pp) (cons p pp) nil)) - (search-failed - nil))) - -;;; ---------------------------------------------------------------------- -;;; -(defun c-comment-find-buffer (&optional buffer) - (or buffer (setq buffer (current-buffer))) - (let ((list c-comment-edit-buffer-alist)) - (catch 'return-value - (while list - (if (eq (nth 1 (car list)) buffer) - (throw 'return-value (car list)) - (setq list (cdr list))))))) - -;;; ---------------------------------------------------------------------- -;;; -(defun c-comment-find-c-buffer (&optional buffer) - (or buffer (setq buffer (current-buffer))) - (let ((list c-comment-edit-buffer-alist)) - (catch 'return-value - (while list - (if (eq (car (car list)) buffer) - (throw 'return-value (car list)) - (setq list (cdr list))))))) - -;;}}} - -;;{{{ code: edit - -;;; ---------------------------------------------------------------------- -;;; 1995-09-07 Jake Colman supplied basic code -;;; -;;;###autoload -(defun c-comment-edit-at-point () - "Edit C comment at point. -If point is inside of a comment, the comment is edited. Otherwise, a new -comment is created at point. -" - (interactive) - (let* ((cs comment-start) - (ce comment-end) - comment) - (when (memq major-mode '(c-mode c++-mode cc-mode)) - ;; override the comment settings, because C++ has - ;; "//" and "" by default and that's not what we want - (setq cs "/*" ce "*/")) - - (if (c-comment-area cs ce) - (c-comment-edit nil) - ;; The catch is, that we first create a comment and then - ;; pass control to the main. - (setq comment (concat cs " " ce)) - (insert comment) - (goto-char (- (point) (length comment))) ;go inside it - (c-indent-command) - (c-comment-edit nil)))) - -;;; ---------------------------------------------------------------------- -;;; -(defun c-comment-edit-end () - "End c-comment-edit. -C comment is replaced by its edited counterpart in the appropriate C buffer. -Indentation will be the same as the original." - (interactive) - (let ((tuple (c-comment-find-buffer)) - (line1-empty c-comment-edit-empty-1-line) - (i 0) - edited - char-count) - - (if (null tuple) - (error "Not a c-comment-edit buffer.")) - - (let ((inhibit-quit t) - (c-comment-c-buffer (car tuple)) - (c-comment-buffer (nth 1 tuple)) - (c-comment-start (nth 2 tuple)) - (c-comment-end (nth 3 tuple))) - - (cond - ((buffer-modified-p) - ;; rebuild the comment - (goto-char (point-min)) - - (if (null line1-empty) - (insert "/*") - (insert "/*\n")) - - (if (string= c-comment-leader " ") - (while (not (eobp)) - (setq i (1+ i)) - (if (eq 1 i) - (insert " ") - (if (not (eolp)) (insert c-comment-leader " "))) - (forward-line)) - (setq i 0) - (while (not (eobp)) - (setq i (1+ i)) - (if (and (eq 1 i) (null line1-empty)) - (insert " ") - (insert c-comment-leader (if (eolp) "" " "))) - (forward-line))) - - (if (not (char-equal (preceding-char) ?\n)) - (insert "\n")) - - (insert (if (string= c-comment-leader " *") " */" "*/")) - - ;; indent if necessary - (let ((indention - (save-excursion - (set-buffer c-comment-c-buffer) - (goto-char c-comment-start) - (current-column)))) - (goto-char (point-min)) - (unless (zerop indention) - ;; first line is already indented - ;; in the C buffer - (forward-line) - (while (not (eobp)) - (indent-to indention) - (forward-line)))) - - (setq edited t) ;Raise the Flag - (run-hooks 'c-comment-edit-end-hook) - - ;; replace the old comment with the new - - (save-excursion - (setq char-count (- (point-max) (point-min)) ) - (set-buffer c-comment-c-buffer) - - (delete-region c-comment-start c-comment-end) - (goto-char c-comment-start) - - (insert-buffer c-comment-buffer) - - ;; save values for possible hook function - - (setq c-comment-edit-beg-c (marker-position c-comment-start) - c-comment-edit-end-c (+ c-comment-edit-beg-c char-count) - c-comment-edit-bufc c-comment-c-buffer) - - ;; The colors vanished, when we deleted that region and inserted - ;; new comment into buffer, lets get them back - - (if (and (featurep 'font-lock) - (symbol-value 'font-lock-mode)) - (funcall - (symbol-function 'font-lock-fontify-region) - c-comment-edit-beg-c c-comment-edit-end-c)))) - - (t - (message "No change."))) - - ;; .................................................. cond - - (c-comment-restore-state) - - ;; switch to the C buffer - - (if (get-buffer-window c-comment-c-buffer) - (select-window (get-buffer-window c-comment-c-buffer)) - (switch-to-buffer c-comment-c-buffer)) - - ;; delete the window viewing the comment buffer - - (and (get-buffer-window c-comment-buffer) - (delete-window (get-buffer-window c-comment-buffer))) - - ;; unlink the tuple from c-comment-edit-buffer-alist - - (setq c-comment-edit-buffer-alist - (delq tuple c-comment-edit-buffer-alist)) - - ;; let Emacs reclaim various resources - - (save-excursion - (set-buffer c-comment-buffer) - (set-buffer-modified-p nil) - (kill-buffer c-comment-buffer)) - - ;; Now kill the markers so that they don't consume resources - - (set-marker c-comment-start nil) - (set-marker c-comment-end nil)) - - (if edited ;only if touched the contents - (run-hooks 'c-comment-edit-exit-hook)))) - -;;}}} -;;{{{ code: abort - -;;; ---------------------------------------------------------------------- -;;; -(defun c-comment-edit-abort () - "Abort a c-comment-edit with no change." - (interactive) - (let* ((tuple (c-comment-find-buffer)) - (c-comment-c-buffer (car tuple)) - (c-comment-buffer (nth 1 tuple)) - (c-comment-start (nth 2 tuple)) - (c-comment-end (nth 3 tuple))) - - (if (null tuple) - (error "Not a c-comment-edit buffer.")) - - ;; switch to the C buffer - - (if (get-buffer-window c-comment-c-buffer) - (select-window (get-buffer-window c-comment-c-buffer)) - (switch-to-buffer c-comment-c-buffer)) - - (let ((inhibit-quit t)) - (save-excursion - (set-buffer c-comment-buffer) - (set-buffer-modified-p nil) - (if c-comment-edit-other-buffer - (delete-window)) - (kill-buffer c-comment-buffer)) - ;; unlink the tuple from c-comment-edit-buffer-alist - (setq c-comment-edit-buffer-alist - (delq tuple c-comment-edit-buffer-alist)) - (set-marker c-comment-start nil) - (set-marker c-comment-end nil) - (message "Aborted with no change.") - (c-comment-restore-state)))) - -;;}}} -;;{{{ code: main - -;;; ---------------------------------------------------------------------- -;;; -;;;###autoload -(defun c-comment-edit (&optional search-prefix com-start com-end) - "Edit multi-line C comments. -This command allows the easy editing of a multi-line C comment like this: - /* - * ... - * ... - */ -The comment may be indented or flush with the left margin. - -If point is within a comment, that comment is used. Otherwise the -comment to be edited is found by searching forward from point. - -With one \\[universal-argument] searching starts after moving back one - paragraph. -With two \\[universal-argument]'s searching starts at the beginning of the - current or proceeding C function. -With three \\[universal-argument]'s searching starts at the beginning of the - current page. -With four \\[universal-argument]'s searching starts at the beginning of the - current buffer (clipping restrictions apply). - -Once located, the comment is copied into a temporary buffer, the comment -leaders and delimiters are stripped away and the resulting buffer is -selected for editing. The major mode of this buffer is controlled by -the variable `c-comment-edit-mode'. - -Use \\[c-comment-edit-end] when you have finished editing the comment. The -comment will be inserted into the original buffer with the appropriate -delimiters and indention, replacing the old version of the comment. If -you don't want your edited version of the comment to replace the -original, use \\[c-comment-edit-abort]." - (interactive "*P") - (catch 'out - (let ((inhibit-quit t) - (bname c-comment-edit-bname) - (other-bedit c-comment-edit-other-buffer) - marker - cs ce - tem - c-comment-fill-column - c-comment-buffer - c-comment-start - c-comment-end) - - (cond - ((and com-start com-end) ;don't touch they are set. - nil) - - ((memq major-mode '(c-mode c++-mode cc-mode)) - ;; override the comment settings, because C++ has - ;; "//" and "" by default and that's not what we want - (setq cs "/*" ce "*/")) - - (t - (setq cs (or comment-start - "cbAnything##")) - (setq ce (or comment-end - "ceAnything##")))) - - ;; What was the prefix arg ? - - (cond ((equal search-prefix '(4)) - (backward-paragraph)) - ((equal search-prefix '(16)) - (end-of-defun) - (beginning-of-defun) - (backward-paragraph)) - ((equal search-prefix '(64)) - (backward-page)) - ((equal search-prefix '(256)) - (goto-char (point-min)))) - - (if (and (null search-prefix) - (setq tem (c-comment-area cs ce))) - (setq c-comment-start (c-comment-marker (car tem)) - c-comment-end (c-comment-marker (cdr tem))) - (let (start end) - (condition-case nil - (c-comment-save-point - (search-forward cs) - (setq start (- (point) (length cs))) - (search-forward ce) - (setq end (point))) - (search-failed - (message - (concat "No C comment found. Check comment-start: " - cs "|" ce)) - (throw 'out t))) - (setq c-comment-start (c-comment-marker start)) - (setq c-comment-end (c-comment-marker end)))) - - ;; calculate the correct fill-column for the comment - - (setq c-comment-fill-column - (- fill-column - (save-excursion - (goto-char c-comment-start) - (+ (length comment-start) (current-column))))) - - ;; create the comment buffer - - (setq c-comment-buffer - (generate-new-buffer (concat (buffer-name) bname))) - - ;; link into the c-comment-edit-buffer-alist - - (setq c-comment-edit-buffer-alist - (cons (list (current-buffer) c-comment-buffer - c-comment-start c-comment-end) - c-comment-edit-buffer-alist)) - - ;; copy to the comment to the comment-edit buffer - - (copy-to-buffer c-comment-buffer - (+ c-comment-start 2) (- c-comment-end 2)) - - ;; mark the position of point, relative to the beginning of the - ;; comment, in the comment buffer. (if point is within a comment.) - - (or search-prefix (< (point) c-comment-start) - (setq marker (c-comment-marker (+ (- (point) c-comment-start 2) 1) - c-comment-buffer))) - ;; ............................................................... - ;; select the comment buffer for editing - - (c-comment-save-state) - - (if (null other-bedit) - (switch-to-buffer c-comment-buffer) - (switch-to-buffer-other-window c-comment-buffer)) - - ;; remove the comment leaders and delimiters - - (goto-char (point-min)) - - (while (not (eobp)) - (and (re-search-forward c-comment-leader-regexp nil t) - (replace-match "" nil t)) - (forward-line)) - - ;; run appropriate major mode - - (funcall (or c-comment-edit-mode 'fundamental-mode)) - - ;; override user's default fill-column here since it will lose if - ;; the comment is indented in the C buffer. - - (setq fill-column c-comment-fill-column) - - ;; delete one leading whitespace char - - (goto-char (point-min)) - - (if (looking-at "[ \n\t]") - (delete-char 1)) - - ;; restore cursor if possible - - (goto-char (or marker (point-min))) - - ;; defontify to get a clear look at text - - (put-text-property (point-min) (point-max) 'face 'default) - - (set-buffer-modified-p nil)) - ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ let end ^^^ - - (use-local-map c-com-mode-map) - (run-hooks 'c-comment-edit-hook) - - (message - (substitute-command-keys - (concat "Type \\[c-comment-edit-end] to end edit, " - "\\[c-comment-edit-abort] to abort with no change."))))) - - ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ catch end ^^^ - -;;}}} - -;;{{{ Example -;;; ......................................................... &example ... - -;; - Here is ready setup, which you could use right away. -;; - I am used to program all my C/C++ function like this, where the -;; header is just before each function: -;; -;; /************************************************************************* -;; * FUNCTION: MyFunc -;; ************************************************************************* -;; * DESCRIPTION -;; * - This is function is the main entry point to class myClass. -;; * it handles reading the oracle database.... -;; * -;; * SPECIAL -;; * - Note, that the oracle connection must be verified before your're -;; * using this function.... -;; * -;; * RETURNS -;; * - Creates object errorAtom which hold data about the promlem occurred. -;; * other -;; *************************************************************************/ -;; errorAtom_c *myClass_c::Execute(char * ptr) -;; { -;; -;; } -;; -;; -;; - In order to maintain the '*****' breaks correctly you have to use some -;; cleanup function like one below. It detects if the Comment has -;; '****' in it and does nothing if it's regular comment. -;; -;; - Remember that when the comment has been edited, the comment style you -;; choosed, affects the function. This supposes you have use the 'one star' -;; style. - -;; Setting proper hooks. -;; I seldom need M-c (capitalize word) in C/C++ -;; If you use many hooks, use command add-hook instead. -;; -;; (setq c++-mode-hook 'c++-my-hook) -;; (defun c++-my-hook () -;; (local-set-key "\M-c" 'c-comment-edit)) -;; -;; (setq c-mode-hook 'c-my-hook) -;; (defun c-my-hook () -;; (local-set-key "\M-c" 'c-comment-edit)) - -;; (defun my-com-end () -;; "C- comment edit cleanup." -;; (let* ((sep (make-string 70 ?* )) ;what separator you want to use -;; (fix-re "[-=*] [-=*][-=*]" ) ;the gap " " is in buffer -;; (back-step 3) ;depends on the fix-re -;; (break-re " +[-=*][-=*][-=*]*") ;at least two continuous chars -;; ) -;; -;; ;; To preserve indentation. Remember that C-comment markers are -;; ;; added to the beginning -;; -;; (untabify (point-min) (point-max)) -;; -;; -;; ;; - We are in comment buffer now, so we can move freely with goto-char -;; ;; - fix all break-marked lines to certain length -;; -;; (goto-char (point-min)) -;; (while (re-search-forward fix-re nil t) -;; (backward-char back-step) (kill-line) (insert sep)) -;; -;; ;; - Check if the last line has separator == it is function header -;; ;; - The last line holds "*/", so look at the previous one. -;; -;; (goto-char (point-max)) (forward-line -1) -;; -;; (cond -;; ((looking-at break-re) -;; ;; Remove that lonely "*/" and shift it one line up -;; ;; -;; (goto-char (point-max)) (beginning-of-line) -;; (kill-line) -;; (backward-delete-char 1) -;; (insert "/"))) ;terminate C comment -;; nil)) ;hook must return this - -;;}}} - -(provide 'c-comment-edit) -(run-hooks 'c-comment-edit-load-hook) - -;;; c-comment-edit2.el ends here diff --git a/emacs_el/tiny-tools/other/calist.el b/emacs_el/tiny-tools/other/calist.el deleted file mode 100644 index 093ce68..0000000 --- a/emacs_el/tiny-tools/other/calist.el +++ /dev/null @@ -1,265 +0,0 @@ -;;; calist.el --- Condition functions - -;; Copyright (C) 1998 MORIOKA Tomohiko. - -;; Author: MORIOKA Tomohiko -;; Keywords: condition, alist, tree - -;; This file is part of APEL (A Portable Emacs Library). - -;; 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 program; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. -;; -;; Visit for more information - -;;; Code: - -(eval-when-compile (require 'cl)) - -(defvar calist-field-match-method-obarray [nil]) - -(defun define-calist-field-match-method (field-type function) - "Set field-match-method for FIELD-TYPE to FUNCTION." - (fset (intern (symbol-name field-type) calist-field-match-method-obarray) - function)) - -(defun calist-default-field-match-method (calist field-type field-value) - (let ((s-field (assoc field-type calist))) - (cond ((null s-field) - (cons (cons field-type field-value) calist)) - ((eq field-value t) - calist) - ((equal (cdr s-field) field-value) - calist)))) - -(defsubst calist-field-match-method (field-type) - (condition-case nil - (symbol-function - (intern-soft - (symbol-name field-type) calist-field-match-method-obarray)) - (error (symbol-function 'calist-default-field-match-method)))) - -(defsubst calist-field-match (calist field-type field-value) - (funcall (calist-field-match-method field-type) - calist field-type field-value)) - -(defun ctree-match-calist (rule-tree alist) - "Return matched condition-alist if ALIST matches RULE-TREE." - (if (null rule-tree) - alist - (let ((type (car rule-tree)) - (choices (cdr rule-tree)) - default) - (catch 'tag - (while choices - (let* ((choice (car choices)) - (choice-value (car choice))) - (if (eq choice-value t) - (setq default choice) - (let ((ret-alist (calist-field-match alist type (car choice)))) - (if ret-alist - (throw 'tag - (if (cdr choice) - (ctree-match-calist (cdr choice) ret-alist) - ret-alist)))))) - (setq choices (cdr choices))) - (if default - (let ((ret-alist (calist-field-match alist type t))) - (if ret-alist - (if (cdr default) - (ctree-match-calist (cdr default) ret-alist) - ret-alist)))))))) - -(defun ctree-match-calist-partially (rule-tree alist) - "Return matched condition-alist if ALIST matches RULE-TREE." - (if (null rule-tree) - alist - (let ((type (car rule-tree)) - (choices (cdr rule-tree)) - default) - (catch 'tag - (while choices - (let* ((choice (car choices)) - (choice-value (car choice))) - (if (eq choice-value t) - (setq default choice) - (let ((ret-alist (calist-field-match alist type (car choice)))) - (if ret-alist - (throw 'tag - (if (cdr choice) - (ctree-match-calist-partially - (cdr choice) ret-alist) - ret-alist)))))) - (setq choices (cdr choices))) - (if default - (let ((ret-alist (calist-field-match alist type t))) - (if ret-alist - (if (cdr default) - (ctree-match-calist-partially (cdr default) ret-alist) - ret-alist))) - (calist-field-match alist type t)))))) - -(defun ctree-find-calist (rule-tree alist &optional all) - "Return list of condition-alist which matches ALIST in RULE-TREE. -If optional argument ALL is specified, default rules are not ignored -even if other rules are matched for ALIST." - (if (null rule-tree) - (list alist) - (let ((type (car rule-tree)) - (choices (cdr rule-tree)) - default dest) - (while choices - (let* ((choice (car choices)) - (choice-value (car choice))) - (if (eq choice-value t) - (setq default choice) - (let ((ret-alist (calist-field-match alist type (car choice)))) - (if ret-alist - (if (cdr choice) - (let ((ret (ctree-find-calist - (cdr choice) ret-alist all))) - (while ret - (let ((elt (car ret))) - (or (member elt dest) - (setq dest (cons elt dest)))) - (setq ret (cdr ret)))) - (or (member ret-alist dest) - (setq dest (cons ret-alist dest)))))))) - (setq choices (cdr choices))) - (or (and (not all) dest) - (if default - (let ((ret-alist (calist-field-match alist type t))) - (if ret-alist - (if (cdr default) - (let ((ret (ctree-find-calist - (cdr default) ret-alist all))) - (while ret - (let ((elt (car ret))) - (or (member elt dest) - (setq dest (cons elt dest)))) - (setq ret (cdr ret)))) - (or (member ret-alist dest) - (setq dest (cons ret-alist dest))))))) - dest))) - -(defun calist-to-ctree (calist) - "Convert condition-alist CALIST to condition-tree." - (if calist - (let* ((cell (car calist))) - (cons (car cell) - (list (cons (cdr cell) - (calist-to-ctree (cdr calist)))))))) - -(defun ctree-add-calist-strictly (ctree calist) - "Add condition CALIST to condition-tree CTREE without default clause." - (cond ((null calist) ctree) - ((null ctree) - (calist-to-ctree calist)) - (t - (let* ((type (car ctree)) - (values (cdr ctree)) - (ret (assoc type calist))) - (if ret - (catch 'tag - (while values - (let ((cell (car values))) - (if (equal (car cell)(cdr ret)) - (throw 'tag - (setcdr cell - (ctree-add-calist-strictly - (cdr cell) - (delete ret (copy-alist calist))))))) - (setq values (cdr values))) - (setcdr ctree (cons (cons (cdr ret) - (calist-to-ctree - (delete ret (copy-alist calist)))) - (cdr ctree)))) - (catch 'tag - (while values - (let ((cell (car values))) - (setcdr cell - (ctree-add-calist-strictly (cdr cell) calist))) - (setq values (cdr values))))) - ctree)))) - -(defun ctree-add-calist-with-default (ctree calist) - "Add condition CALIST to condition-tree CTREE with default clause." - (cond ((null calist) ctree) - ((null ctree) - (let* ((cell (car calist)) - (type (car cell)) - (value (cdr cell))) - (cons type - (list (list t) - (cons value (calist-to-ctree (cdr calist))))))) - (t - (let* ((type (car ctree)) - (values (cdr ctree)) - (ret (assoc type calist))) - (if ret - (catch 'tag - (while values - (let ((cell (car values))) - (if (equal (car cell)(cdr ret)) - (throw 'tag - (setcdr cell - (ctree-add-calist-with-default - (cdr cell) - (delete ret (copy-alist calist))))))) - (setq values (cdr values))) - (if (assq t (cdr ctree)) - (setcdr ctree - (cons (cons (cdr ret) - (calist-to-ctree - (delete ret (copy-alist calist)))) - (cdr ctree))) - (setcdr ctree - (list* (list t) - (cons (cdr ret) - (calist-to-ctree - (delete ret (copy-alist calist)))) - (cdr ctree))))) - (catch 'tag - (while values - (let ((cell (car values))) - (setcdr cell - (ctree-add-calist-with-default (cdr cell) calist))) - (setq values (cdr values))) - (let ((cell (assq t (cdr ctree)))) - (if cell - (setcdr cell - (ctree-add-calist-with-default (cdr cell) - calist)) - (let ((elt (cons t (calist-to-ctree calist)))) - (or (member elt (cdr ctree)) - (setcdr ctree (cons elt (cdr ctree)))))) - ctree)))) - -(defun ctree-set-calist-strictly (ctree-var calist) - "Set condition CALIST in CTREE-VAR without default clause." - (set ctree-var - (ctree-add-calist-strictly (symbol-value ctree-var) calist))) - -(defun ctree-set-calist-with-default (ctree-var calist) - "Set condition CALIST to CTREE-VAR with default clause." - (set ctree-var - (ctree-add-calist-with-default (symbol-value ctree-var) calist))) - -))));;; @ end -;;; - -(provide 'calist) - -;;; calist.el ends here diff --git a/emacs_el/tiny-tools/other/complete-menu.el b/emacs_el/tiny-tools/other/complete-menu.el deleted file mode 100644 index 012fd68..0000000 --- a/emacs_el/tiny-tools/other/complete-menu.el +++ /dev/null @@ -1,431 +0,0 @@ -;;; complete-menu.el --- show completions in X-popup menu - -;;{{{ Id - -;; This file is not part of Emacs - -;; Copyright (C) 1993 Alon Albert -;; Author: Alon Albert -;; Maintainer: Jari Aalto -;; Created: 1993-12-07 - -;; COPYRIGHT NOTICE -;; -;; This program is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by the Free -;; Software Foundation; either version 2 of the License, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -;; for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with program; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. -;; -;; Visit for more information - -;;}}} -;;{{{ Install -;;; install: - -;; Put this file in your load-path and insert the following in .emacs -;; -;; (require 'cl) -;; (when window-system -;; (require 'complete-menu)) -;; -;; Or use autoload, your emacs starts up faster (then maybe not, because -;; there is so much code) -;; -;; (when window-system -;; (setq cm-load-hook 'cm-install-default) ;; Need advices too -;; (autoload 'cm-minibuffer-completion-help "complete-menu") -;; (define-key minibuffer-local-completion-map [C-tab] -;; 'cm-minibuffer-completion-help) -;; (define-key minibuffer-local-must-match-map [C-tab] -;; 'cm-minibuffer-completion-help) -;; (substitute-key-definition 'minibuffer-completion-help -;; 'cm-minibuffer-completion-help -;; minibuffer-local-completion-map) -;; (substitute-key-definition 'minibuffer-completion-help -;; 'cm-minibuffer-completion-help -;; minibuffer-local-must-match-map) -;; (substitute-key-definition 'PC-completion-help -;; 'cm-minibuffer-completion-help -;; minibuffer-local-completion-map) -;; (substitute-key-definition 'PC-completion-help -;; 'cm-minibuffer-completion-help -;; minibuffer-local-must-match-map)) -;; -;; -;; The X-popup appears if "?" is pressed in minibuffer. - -;;}}} -;;{{{ Documentation -;;; Commentary: - -;; Press "?" while in minibuffer to get the X-popup -;; Also supports unix like wildcards so: -;; -;; find file: comp*.el* -;; -;; This utility may be useful for `describe-function' and `describe-variable'. -;; typing C-h v *word* pops a menu with all variables with the word "word" -;; in them. (something like apropos) - -;;}}} -;;{{{ History - -;;; History: - -;; v1.10 2001-03-05 [jari] Released -;; - Added Autoload statements. -;; -;; v1.8-1.9 May 24 1997 [jari] Released -;; - Added byte compilation stop for XEmacs, thank to note from -;; Rick Flower -;; - Added defcustom support. Checkdoc 1.29 clear. -;; -;; v1.7 Dec 5 1996 [jari] Released -;; - I was reordering my emacs startup files to make -;; maximum use of autoloads and delete all unnecessary -;; require commands, then I noticed that this file didn't have -;; autoload choice. -;; - updated the installation instructions, so that you this -;; package is loaded only in demand. -;; -;; v1.6 Jun 3 1996 [jari] Released -;; - Noticed bug. I I pressed "*" and tried to find all temporary -;; buffers, it showed me all. Too bad... -;; - Now I can hit "*m" to show me all "*mail* foo" "*mail* quux" -;; and other pending mail buffers. -;; - Advertise: If you want to have user name attached to mail -;; buffer, like above, get my lisp libs and do this: -;; -;; (require 'tinylibmail) -;; (add-hook 'mail-setup-hook 'ti::mail-rename-buffer) -;; -;; v1.5 Jun 3 1996 [jari] Released -;; - Error in installation, now there is cm-install-2 -;; -;; v1.4 Jun 3 1996 [jari] NotReleased -;; - Small corrections -;; -;; v1.3 Sep 21 1995 [jari] NotReleased -;; - Bryan M Kramer popped up in g.e.help -;; asking why this package didn't work in XEmacs any more. -;; It turned out that this package wasn't archived anywhere, nor -;; in the OHIO nor did any archie could find it. So I received -;; copy of this code and packaged whole file in suitable form. -;; - added separate installation, added final load hook, replaced -;; right copyright info. added advice, lots of small stuff.. -;; - Corrected bug in cm-minibuffer-completion-help: if user didn't -;; choose anything, it cleared the minibuffer entry. Now the original -;; entry is preserved. -;; -;; v1.2 Aug 22 1993 [Alon] -;; - a few minor fixes -;; - a new chooser from *completions* buffer that allows completion to -;; be yanked into any buffer (not just the minibuffer) -;; -;; v1.1 July 18 1993 [Alon] -;; - Cleaner faster version. -;; - Special thanks to Kevin Rodgers -;; for an intriguing discussion about list manipulation in emacs lisp -;; -;; v1.0 July 7 1993: [Alon] -;; - First release. - -;;}}} - -;;; Code: - -;;; ......................................................... &require ... - -(require 'advice) - -(eval-and-compile - (when (boundp 'xemacs-logo) - (message "\n\ - ** complete-menu.el: This package works only in Emacs, because the popup\n\ - function is not compatible between Emacs versions.\n\ - Ignore `Aborted' error command if you're\n\ - byte compiling this file in XEmacs.") - (error "Aborted."))) - -(defgroup complete-menu nil - "Provides X-popup list where you can select completions items. See ? key." - :prefix "complete-menu-" - :group 'extensions) - -;;{{{ setup: variables - -;;; ....................................................... &variables ... - -;;; or if you dont't want to substitute the originals, use -;;; 'cm-install-2 -;;; -;;;###autoload -(defcustom cm-load-hook '(cm-install-default) - "*Hook run when file has been loaded." - :type 'hook - :group 'complete-menu) - -;; handy if you want to call from non-mouse, eg. pressing key. -;; -(defcustom cm-x-coord 170 - "*Default X menu coordinate." - :type 'integer - :group 'complete-menu) - -(defcustom cm-y-coord 170 - "*Default Y menu coordinate." - :type 'integer - :group 'complete-menu) - -(defcustom cm-max-entries-in-menu 45 - "*Maximum lines to display in a single menu pane" - :type 'integer - :group 'complete-menu) - -(defcustom cm-store-cut-buffer t - "If not nill then store selection in mouse cut buffer" - :type 'boolean - :group 'complete-menu) - -(defcustom cm-execute-on-completion t - "If not nil then exucute command after completion" - :type 'boolean - :group 'complete-menu) - -(defvar cm-wildcard-to-regexp - '((?* . ".*") - (?. . "\\.") - (?? . ".")) - "Translation table from wildcard format to regexp format") - -;;}}} -;;{{{ code: funcs - -;;; ....................................................... &Functions ... - -;;; ---------------------------------------------------------------------- -;;; -(defun cm-make-regexp (wildcard) - "Make a regexp out of unix like WILDCARD." - (let* ((char-list (append wildcard))) - (mapconcat (function - (lambda (elt) - (let ((regexp (cdr (assoc elt cm-wildcard-to-regexp)))) - (if regexp - regexp - (char-to-string elt))))) - char-list ""))) - -;;; ---------------------------------------------------------------------- -;;; -(defun cm-old-zap-to-char (arg char) - "Kill up to (but not including) ARG'th occurrence of CHAR. -Goes backward if ARG is negative; goes to end of buffer if CHAR not found." -;;; (interactive "*p\ncZap to char: ") - (kill-region (point) (if (search-forward (char-to-string char) nil t arg) - (progn (goto-char - (if (> arg 0) (1- (point)) (1+ (point)))) - (point)) - (if (> arg 0) (point-max) (point-min))))) - -;;; ---------------------------------------------------------------------- -;;; -;;;###autoload -(defun cm-minibuffer-completion-help () - "List completions in a menu and copy selction into minibuffer" - (interactive) - (message "Making completion list...") - (let* ((complete (buffer-string)) - (mouse-pos (mouse-position)) - (mouse-pos (if (nth 1 mouse-pos) - mouse-pos - (set-mouse-position (car mouse-pos) - (/ (frame-width) 2) 2) - (unfocus-frame) - (mouse-position))) - (pos (list (list (car (cdr mouse-pos)) - (1+ (cdr (cdr mouse-pos)))) - (car mouse-pos))) - (match nil) - (panes nil) - (pane nil) - (i 0) - - completion-list - name - menu - elt) - - (if (string-match "?" complete) - (setq match (format "^%s$" (cm-make-regexp - (file-name-nondirectory complete))) - complete (substring complete 0 (match-beginning 0)))) - - (setq completion-list - (sort (all-completions - complete - minibuffer-completion-table - minibuffer-completion-predicate) - 'string<)) - - (message "Making completion list... Done") - (message "Creating menu...") - - (while (setq elt (car completion-list)) - (if (or (null match) - (string-match match elt)) - (setq pane (cons elt pane) - i (1+ i))) - (setq completion-list (cdr completion-list)) - (if (= i cm-max-entries-in-menu) - (setq panes (cons pane (nreverse panes)) - pane nil - i 0))) - - (if pane (setq panes (cons pane (nreverse panes)))) - - (setq menu (cons "Completions" - (mapcar (function - (lambda (elt) - (cons (car elt) - (mapcar (function - (lambda (elt) - (cons elt elt))) - elt)))) - panes))) - - (message "Creating menu... Done") - (if (not (car (cdr menu))) - (beep) - (setq name (x-popup-menu pos menu)) - (cm-old-zap-to-char -1 ?/) - (if (null name) - ;; User didn't select anything - (insert complete) ;put previous back. - (insert name) - (if cm-store-cut-buffer - (kill-new name)) - (if cm-execute-on-completion - (exit-minibuffer)))))) - -;;; ---------------------------------------------------------------------- -;;; -(defun cm-delete-max-match (string) - "Return maximum match for STRING." - (let* ((len (min (length string) (1- (point)))) - (string (substring string 0 len))) - (goto-char (- (point) len)) - (while (and (> len 0) (null (looking-at string))) - (setq string (substring string 0 -1) - len (1- len)) - (forward-char 1)) - (delete-char len))) - -;;; ---------------------------------------------------------------------- -;;; -(defun cm-choose-completion (event) - "Display completion menu. EVENT is x popup event." - (interactive "e") - (let ((buffer (window-buffer)) - choice) - (save-excursion - (set-buffer (window-buffer (posn-window (event-start event)))) - (save-excursion - (goto-char (posn-point (event-start event))) - (skip-chars-backward "^ \t\n") - (let ((beg (point))) - (skip-chars-forward "^ \t\n") - (setq choice (buffer-substring beg (point)))))) - (set-buffer buffer) - (cm-delete-max-match choice) - (insert choice) - (and (equal buffer (window-buffer (minibuffer-window))) - cm-execute-on-completion (exit-minibuffer)))) - -;;; ---------------------------------------------------------------------- -;;; Not activated until user wants it, this overrides ? keys -;;; -(defadvice minibuffer-completion-help (around cm-x-complete dis) - "Replaces function and calls cm-minibuffer-completion-help. -Displays completions in X-menu instead of separate buffer." - (cm-minibuffer-completion-help)) - -;;; ---------------------------------------------------------------------- -;;; -(defadvice PC-completion-help (around cm-x-complete dis) - "Replaces function and calls cm-minibuffer-completion-help. -Displays completions in X-menu instead of separate buffer." - (cm-minibuffer-completion-help)) - -;;; ---------------------------------------------------------------------- -;;; You may also want to bind it to "more closer key", [left hand -;;; pops the X, and right controls the mouse]: -;;; -(defun cm-install-2 () - "Install the X-menuing feature to separate C-tab key." - (define-key minibuffer-local-completion-map [C-tab] - 'cm-minibuffer-completion-help) - (define-key minibuffer-local-must-match-map [C-tab] - 'cm-minibuffer-completion-help)) - -;;; ---------------------------------------------------------------------- -;;; -;;;###autoload -(defun cm-install-default (&optional arg verb) - "Install the X-menuing feature. With ARG, remove X-menuing. VERB. -Note: installation is only possible in X envinronment." - (interactive "P") - (let* ((map1 'minibuffer-local-completion-map) - (map2 'minibuffer-local-must-match-map) - (ofun1 'minibuffer-completion-help) - (ofun2 'PC-completion-help) - (nfun 'cm-minibuffer-completion-help)) - - (or verb - (setq verb (interactive-p))) - - (if (null window-system) - (if verb - (message "No window system detected. Cannot do nothing.")) - (cond - (arg - (substitute-key-definition nfun ofun1 (eval map1)) - (substitute-key-definition nfun ofun1 (eval map2)) - - (substitute-key-definition nfun ofun2 (eval map1)) - (substitute-key-definition nfun ofun2 (eval map2)) - - (ad-disable-advice ofun1 'around 'cm-x-complete) - (ad-disable-advice ofun2 'around 'cm-x-complete) - (if verb - (message "X-menu completion off"))) - (t - (substitute-key-definition ofun1 nfun (eval map1)) - (substitute-key-definition ofun1 nfun (eval map2)) - - (substitute-key-definition ofun2 nfun (eval map1)) - (substitute-key-definition ofun2 nfun (eval map2)) - - (ad-enable-advice ofun1 'around 'cm-x-complete) - (ad-enable-advice ofun2 'around 'cm-x-complete) - (if verb - (message "X-menu completion on")))) - (ad-activate ofun1) - (ad-activate ofun2)))) - -;;}}} - -(provide 'complete-menu) -(run-hooks 'cm-load-hook) - -;;; complete-menu.el ends here diff --git a/emacs_el/tiny-tools/other/date-parse.el b/emacs_el/tiny-tools/other/date-parse.el deleted file mode 100644 index adbdd5a..0000000 --- a/emacs_el/tiny-tools/other/date-parse.el +++ /dev/null @@ -1,341 +0,0 @@ -;;; date-parse.el --- Parse and sort dates - -;; This file is not part of Emacs - -;;{{{ Id - -;; Copyright (C) 1989 John Rose -;; Author: John Rose -;; Maintainer: none -;; Packaged-by: Jari Aalto -;; Created: 1989-03 -;; Keywords: extensions - -;; This program is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by the Free -;; Software Foundation; either version 2 of the License, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -;; for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with program; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. -;; -;; Visit for more information - -;;}}} -;;{{{ Install - -;;; Install: - -;; Put this file on your Emacs-Lisp load path, add following into your -;; ~/.emacs startup file. -;; -;; (require 'date-parse) - -;;}}} -;;{{{ Commentary - -;;; Commentary: - -;; Preface, 1989 -;; -;; Hacks for reading dates. Something better needs to be done, -;; obviously. In the file "dired-resort" are dired commands for -;; reordering the buffer by modification time, which is the whole -;; purpose of this exercise. -;; -;;}}} - -;;; Change Log: - -;;; Code: - -(require 'cl-compat) ;; 19.30 'setnth' - -(eval-and-compile - (autoload 'sort-subr "sort")) - -;;; ....................................................... &variables ... - -(defvar parse-date-indices nil - "List of (START END) from last successful call to parse-date.") - -(defconst date-patterns - '(( ;; Sep 29 12:09:55 1986 - "[ \t]*\\([A-Za-z]+\\)[. \t]+\\([0-9]+\\)[, \t]+\ -\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)[, \t]+\ -\\([0-9]+\\)[ \t]*" - 6 1 2 nil 3 4 5) - ( ;; Sep 29 12:09 - "[ \t]*\\([A-Za-z]+\\)[. \t]+\\([0-9]+\\)[, \t]+\ -\\([0-9]+\\):\\([0-9]+\\)[ \t]*" - nil 1 2 nil 3 4) - ( ;; Sep 29 1986 - "[ \t]*\\([A-Za-z]+\\)[. \t]+\\([0-9]+\\)[, \t]+\ -\\([0-9]+\\)[ \t]*" - 3 1 2) - ( ;; Sep 29 - "[ \t]*\\([A-Za-z]+\\)[. \t]+\\([0-9]+\\)[ \t]*" - nil 1 2) - ( ;; 2004-10-14 17:23 - "^[ \t]*\\([0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)-\\([0-9][0-9]\\)[ \t]+\ -\\([0-9][0-9]\\):\\([0-9][0-9]\\)" - 1 2 3 nil 4 5)) - "List of (regexp field field ...), each parsing a different style of date. -The fields locate, in order: - - 1. the year - 2. month - 3. day - 4. weekday, - 5. hour - 6. minute - 7. second - 8. and timezone of the date. - -Any or all can be null, and the list can be short. Each field is nil, -an integer referring to a regexp field, or a 2-list of an integer and -a string-parsing function which is applied (instead of a default) to -the field string to yield the appropriate integer value.") - -;;; ............................................................ &code ... - -(defun parse-date (date &optional exactp nodefault) - "Parse a DATE into a 3-list of year, month, day. -This list may be extended by the weekday, -and then by the hour, minute, second, and timezone -\(if such information is found), making a total of eight list elements. -Optional arg EXACTP means the whole string must hold the date. -Optional NODEFAULT means the date is not defaulted (to the current year). -In any case, if parse-date succeeds, parse-date-indices is set -to the 2-list holding the location of the date within the string." - (if (not (stringp date)) - date - (let ((ptr date-patterns) - (string date) - start end) - (and (or (string= string "now") - (string= string "today")) - (setq string (current-time-string) - exactp nil)) - (setq date nil) - (while ptr - (let ((pat (car (car ptr))) - (fields (cdr (car ptr)))) - (if (setq start (string-match pat string)) - (setq end (match-end 0))) - (and start - exactp - (or (plusp start) - (< end (length string))) - (setq start nil)) - (setq ptr (cdr ptr)) - (if start - ;; First extract the strings, - ;; and decide which parsers to call. - ;; At this point, the pattern can still fail - ;; if a parser returns nil. - (let ((strs nil) - (fns nil) - (default-fns - '(parse-date-year - parse-date-month - nil ;;day - parse-date-weekday - nil nil nil ;;hhmmss - parse-date-timezone))) - (while fields - (let ((field (car fields)) - (fn (car default-fns))) - (setq fields (cdr fields) - default-fns (cdr default-fns)) - ;; Allow field to be either 3 or (3 string-to-int) - (if (listp field) - (setq field (car field) - fn (car (cdr field)))) - (setq strs - (cons - (cond - ((null field) nil) - ((integerp field) - (substring - string - (match-beginning field) - (match-end field))) - (t field)) - strs)) - (setq fns (cons (or fn 'string-to-int) fns)))) - ;; Now parse them: - (setq strs (nreverse strs) - fns (nreverse fns)) - (setq date strs) ;; Will replace cars. - (while strs - (if (car strs) - (setcar strs - (or (funcall (car fns) (car strs)) - (setq date nil strs nil)))) - (setq strs (cdr strs) fns (cdr fns))) - ;; Break the while? - (if date - (setq ptr nil)))))) - (or nodefault - (null date) - (setq date (default-date-list date))) - (if date - (setq parse-date-indices (list start end))) - date))) - -;; FIXME: Yuck. We only default the year. -(defun default-date-list (date) - "Return DATE list." - (let ((now nil)) - ;; If the year is missing, default it to this year or last year, - ;; whichever is closer. - (or (nth 0 date) - (let ((year (nth 0 (or now (setq now (parse-date "now" t t))))) - (diff (* 30 (- (nth 1 date) (nth 1 now))))) - (if (zerop diff) - (setq diff (- (nth 2 date) (nth 2 now)))) - (if (> diff 7) - (setq year (1- year))) - (setnth 0 date year))) - date)) - -;; Date field parsers: - -(defun parse-date-month (month) - "Parse MONTH." - (if (not (stringp month)) - month - (let ((sym 'parse-date-month-obarray)) - ;; This guy's memoized: - (or (boundp sym) (set sym nil)) - (setq sym (intern month - (or (symbol-value sym) - (set sym (make-vector 51 0))))) - (or (boundp sym) - (let ((try nil) - (key (downcase month))) - (or try - (plusp (setq try (string-to-int month))) - (setq try nil)) - (or try - (let ((ptr '("january" "february" "march" "april" - "may" "june" "july" "august" - "september" "october" "november" "december")) - (idx 1)) - (while ptr - (if (eql 0 (string-match key (car ptr))) - (setq try idx ptr nil) - (setq idx (1+ idx) ptr (cdr ptr)))))) - (or try - (if (string= key "jly") - (setq try 7))) - (and try - (or (> try 12) - (< try 1)) - (setq try nil)) - (set sym try))) - (symbol-value sym)))) - -(defun parse-date-year (year) - "Parse YEAR." - (if (not (stringp year)) - year - (setq year (string-to-int year)) - (cond - ((> year 9999) nil) - ((<= year 0) nil) - ((> year 100) year) - (t (+ year 1900))))) - -;; Other functions: - -(defun date-compare-key (date &optional integer-p) - "Map DATE to strings preserving ordering. -If optional INTEGER-P is true, yield an integer instead of a string. -In that case, the granularity is minutes, not seconds, -and years must be in this century." - (or (consp date) (setq date (parse-date date))) - (let ((year (- (nth 0 date) 1900)) - (month (- (nth 1 date) 1)) - (day (- (nth 2 date) 1)) - (hour (or (nth 4 date) 0)) - (minute (or (nth 5 date) 0)) - (second (or (nth 6 date) 0))) - (if integer-p - (+ (* (+ (* year 366) (* month 31) day) - (* 24 60)) - (* hour 60) - minute) - ;; Else yield a string, which encodes everything: - (let* ((sz (zerop second)) - (mz (and sz (zerop minute))) - (hz (and mz (zerop hour))) - (fmt - (cond - ((minusp year) - (setq year (+ year 1900)) - (cond (hz "-%04d%c%c") - (mz "-%04d%c%c%c") - (sz "-%04d%c%c%c%02d") - (t "-%04d%c%c%c%02d%02d"))) - ((> year 99) - (setq year (+ year 1900)) - (cond (hz "/%04d%c%c") - (mz "/%04d%c%c%c") - (sz "/%04d%c%c%c%02d") - (t "/%04d%c%c%c%02d%02d"))) - (hz "%02d%c%c") - (mz "%02d%c%c%c") - (sz "%02d%c%c%c%02d") - (t "%02d%c%c%c%02d%02d")))) - (setq month (+ month ?A) day (+ day ?a)) - (setq hour (+ hour ?A)) - (format fmt year month day hour minute second))))) - -(defun date-lessp (date1 date2) - "Compare DATE1 to DATE2 (which may be unparsed strings or parsed date lists). -Equivalent to (string< (date-compare-key date1) (date-compare-key date2))." - (or (consp date1) (setq date1 (parse-date date1))) - (or (consp date2) (setq date2 (parse-date date2))) - (catch 'return - (let ((check (function (lambda (n1 n2) - (or n1 (setq n1 0)) - (or n2 (setq n2 0)) - (cond ((< n1 n2) (throw 'return t)) - ((> n1 n2) (throw 'return nil))))))) - (funcall check (nth 0 date1) (nth 0 date2)) - (funcall check (nth 1 date1) (nth 1 date2)) - (funcall check (nth 2 date1) (nth 2 date2)) - (funcall check (nth 4 date1) (nth 4 date2)) - (funcall check (nth 5 date1) (nth 5 date2)) - (funcall check (nth 6 date1) (nth 6 date2)) - nil))) - -(defun sort-date-fields (reverse beg end) - "Sort lines in region by date value; argument means descending order. -Called from a program, there are three required arguments: -REVERSE (non-nil means reverse order), BEG and END (region to sort)." - (interactive "P\nr") - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) - (sort-subr - reverse 'forward-line 'end-of-line - (function - (lambda () - (date-compare-key - (or (parse-date - (buffer-substring (point) (progn (end-of-line) (point)))) - (throw 'key nil)))))))) - -(provide 'date-parse) - -;;; date-parse.el ends here diff --git a/emacs_el/tiny-tools/other/dired-sort.el b/emacs_el/tiny-tools/other/dired-sort.el deleted file mode 100644 index 20c1133..0000000 --- a/emacs_el/tiny-tools/other/dired-sort.el +++ /dev/null @@ -1,478 +0,0 @@ -;;; dired-sort.el --- Sort by by size, date, field, name and type - -;; This file is not part of Emacs - -;; {{{ Id - -;; Maintainer: Jari Aalto -;; Created: 1989-03 -;; Keywords: extensions -;; -;; This program is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by the Free -;; Software Foundation; either version 2 of the License, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -;; for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with program; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. -;; -;; Visit for more information - -;; }}} -;; {{{ Install - -;;; Install: - -;; Put this file on your Emacs-Lisp load path, add following into your -;; ~/.emacs startup file. -;; -;; (add-hook 'dired-mode-hook '(lambda () (require 'dired-sort))) -;; -;; NOTE: ls-lisp.el, which dired.el uses, by default inserts month names -;; in national format. If the setting is anything other than English, -;; this module *cannot* parse the dired lines. Please add this setting -;; to your Emacs (21.4+) to make dired listing use ISO 8601 date stamps: -;; -;; (setq ls-lisp-format-time-list -;; '("%Y-%m-%d %H:%M" -;; "%Y-%m-%d ")) - -;; }}} -;; {{{ - -;;; Commentary: - -;; -;; Preface, Nov 1997 -;; -;; Not much to say. I have had this package lying in my lisp directory -;; since Emacs 18.xx days. When I noticed that this package doesn't -;; exist in the OHIO archive, neither did the ftpsearch locate it, -;; I decided to clen it up and put publically available. -;; -;; The original author is unknown And the only thing that was in the -;; original documentation was this line: -;; -;; $Header: /tmp_mnt/am/p7/utility/gmacs/f2/RCS/dired-resort.el,v -;; 1.1 88/11/03 13:22:08 fad Exp $ -;; -;; New bindings in dired -;; -;; When you load this file, function `dired-sort-default-keys' is called. -;; The following bindings to dired mode are defined. -;; -;; S" " dired-sort-resort (that's an "s" + SPACE) -;; Ss dired-sort-by-size -;; Sd dired-sort-by-date -;; Sf dired-sort-by-field -;; Sn dired-sort-by-name -;; St dired-sort-by-type -;; -;; }}} - -;;; Change Log: - -;;; Code: - -(require 'date-parse) - -(eval-and-compile - ;; Silence Byte compiler - (defvar revert-buffer-function) - (defvar current-prefix-arg) ;; Elint.el - ;; Not exported from sort.el - (autoload 'sort-subr "sort") - (autoload 'sort-fields-1 "sort") - (autoload 'dired-revert "dired") - (autoload 'dired-get-filename "dired") - (autoload 'dired-move-to-filename "dired") - (autoload 'sort-skip-fields "sort")) - -;;; ....................................................... &variables ... - -(defvar dired-sort-load-hook '(dired-sort-default-keys) - "Hook run when file is loaded.") - -;; File property caching mechanism for dired - -(defvar dired-sort-line-property-table nil - "Buffer local obarray: -Each symbol is a file name whose plist caches file properties, -accessed by #'dired-line-property") -(make-variable-buffer-local 'dired-sort-line-property-table) - -(defvar dired-sort-resort-last-kind '(date) - "What the last sort did to the buffer.") -(make-variable-buffer-local 'dired-sort-resort-last-kind) - -(defvar dired-sort-resort-alist - '(("name" dired-sort-by-name nil "ascending order") - (nil dired-sort-by-name t "descending order") - ("date" dired-sort-by-date nil "most recent first") - (nil dired-sort-by-date t "oldest first") - ("size" dired-sort-by-size nil "biggest first") - (nil dired-sort-by-size t "smallest first") - ("type" dired-sort-by-type t "alphabetically") - ("modes" dired-sort-by-field 1 "file modes") - ("links" dired-sort-by-field 2 "number of links") - ("owner" dired-sort-by-field 3 "file owner") - ("field" dired-sort-by-field (1) "textual field"))) - -;;; ............................................................ &code ... - -(defvar dired-sort-last-sort nil - "Last sort indication.") - -(defun dired-sort-revert-and-decache (&optional arg noconfirm) - "Revert buffer using `dired-revert' ARG and NOCONFIRM." - (if dired-sort-line-property-table - (mapatoms (function (lambda (file) (setplist file nil))) - dired-sort-line-property-table)) - (dired-revert arg noconfirm)) - -(defun dired-sort-line-property (func) - "Call FUNC with one argument: The (absolute) file name of this dired line. -Cache the result, and return it the next time without calling FUNC. - The caches are cleared when the buffer is reverted. - See dired-sort-line-property-table." - (or dired-sort-line-property-table - (progn - (if (eq revert-buffer-function 'dired-revert) - (setq revert-buffer-function 'dired-sort-revert-and-decache)) - (setq dired-sort-line-property-table (make-vector 31 0)))) - (let ((file (intern (dired-get-filename t) dired-sort-line-property-table))) - (or (get file func) - (put file func - (funcall func (symbol-name file)))))) - -(defun dired-sort-move-word-backward () - "move one space dlimited word backward. Must already be on word." - (skip-chars-backward "^ \t" (line-beginning-position)) - (skip-chars-backward " \t" (line-beginning-position)) - (skip-chars-backward "^ \t" (line-beginning-position))) - -;; FIXME: It is unreliable to read words from dired buffer, -;; because the Month name can be in national format. -;; => There is no eas way, doing file stat() would be too -;; expensive to find out the month name? -;; => It is bets to configure Emacs to always use -;; ISO dates only. - -(defun dired-sort-move-to-date (&optional and-extract) - "Details depend on the `dired-extract-size' AND-EXTRACT." - ;; Go two words backward - ;; 4694 Month 16 19:44 file - ;; -rw-rw---- 1 foo foo 2082 2004-10-14 17:23 . - ;; | - ;; start here - (when (dired-move-to-filename) - (let ((end (point))) - (dired-sort-move-word-backward) - (dired-sort-move-word-backward) - ;; Now, should we still take on leap due to Month name? - (unless (looking-at "[0-9][0-9][0-9][0-9]-") - (dired-sort-move-word-backward)) - (if and-extract - (parse-date (buffer-substring (point) end) t) - (point))))) - -(defun dired-sort-extract-date () - "Call `dired-sort-move-to-date'." - (dired-sort-move-to-date t)) - -(defun dired-sort-extract-size () - "Read size with regular expression." - (let ((ret -1)) - (when (dired-sort-move-to-date) - (skip-chars-backward " " (line-beginning-position)) - (skip-chars-backward "0-9" (line-beginning-position)) - (if (looking-at "[0-9]+ ") - (setq ret (read (current-buffer))))) - ret)) - -(defun dired-sort-header-line-p () - "Check `dired-sort-extract-size'." - (save-excursion - (minusp (dired-sort-extract-size)))) - -(defun dired-sort-first-file () - "Goto first file." - (interactive) - (goto-char (point-min)) - (while (and (dired-sort-header-line-p) - (not (eobp))) - (forward-line 1)) - (dired-move-to-filename)) - -(defun dired-sort-extract-date-key (&optional ignore) - "Extract key with IGNORE." - (let ((date (dired-sort-extract-date))) - (if date - (date-compare-key date 'integer)))) - -(defun dired-sort-by-size-key (&optional ignore) - "Sort by zise or IGNORE." - (dired-sort-by-size-key-1 nil)) - -(defun dired-sort-by-size-increasing-key (&optional ignore) - "Sort by zise or IGNORE." - (dired-sort-by-size-key-1 t)) - -(defun dired-sort-resort-menu-options () - "See `dired-sort-resort-alist'." - (list "Help" - (cons "Sort Dired listing by:" - (mapcar - (function(lambda (elt) - (cons - (format "%5s (%s)" - (capitalize (or (nth 0 elt) " '' ")) - (nth 3 elt)) - elt))) - dired-sort-resort-alist)))) - -(defun dired-sort-by-size-key-1 (incr-p) - "Sort possibly with INCR-P." - (let ((size (dired-sort-extract-size)) - (char (save-excursion - (forward-line 0) - (skip-chars-forward " ") - (following-char)))) - (setq char (downcase char)) - (cond - ((not incr-p)) - ((= char ?-) (setq char ?~)) - ((>= char ?a) (setq char (- (+ ?a ?z) char)))) - (format "%c%09d" char size))) - -(defun dired-sort-read-resort-args (&optional res) - "Produce a 1- or 2- list. -Suitable for non-interactive calling of dired-sort-resort. -Optional RES is a line from dired-sort-resort-alist." - (or res - (setq res - (completing-read - (format "Sort by: [%s] " (car dired-sort-resort-last-kind)) - dired-sort-resort-alist - nil t))) - (if (zerop (length res)) - dired-sort-resort-last-kind - (if (atom res) - (setq res (or (assoc res dired-sort-resort-alist) - (error "reading resort")))) - (let ((type (nth 0 res)) - (func (nth 1 res)) - (arg (nth 2 res)) - (what (nth 3 res))) - (let ((ptr dired-sort-resort-alist) elt) - (while (and ptr (null type)) - (setq elt (car ptr) ptr (cdr ptr)) - (if (eq func (nth 1 elt)) - (setq type (nth 0 elt))))) - (setq type (intern type)) - (cond - ((atom arg)) - (current-prefix-arg - (setq arg - (if (integerp (car arg)) - (prefix-numeric-value current-prefix-arg) - (and current-prefix-arg t)))) - ((integerp (car arg)) - (setq arg (read-string (format "What %s? " what)))) - (t (setq arg (y-or-n-p (format "%s? " what))))) - (if (null arg) - type - (list type arg))))) - -;;; ..................................................... &interactive ... - -(defun dired-sort-last-file () - "Go to last file." - (interactive) - (goto-char (point-max)) - (while (and (dired-sort-header-line-p) - (not (bobp))) - (forward-line -1)) - (dired-move-to-filename)) - -(defun dired-sort-narrow-to-files () - "Narrow to visible files." - (interactive) - (narrow-to-region - (save-excursion - (dired-sort-first-file) - (forward-line 0) - (point)) - (save-excursion - (dired-sort-last-file) - (forward-line 1) - (point)))) - -;;;###autoload -(defun dired-sort-by-date (&optional arg) - "In dired, sort the lines by date, newest first. -With ARG, sorts oldest first." - (interactive "P") - (save-restriction - (dired-sort-narrow-to-files) - (let (buffer-read-only) - (goto-char (point-min)) - (sort-subr - (not arg) 'forward-line 'end-of-line - (function - (lambda () - (or (dired-sort-line-property 'dired-sort-extract-date-key))))))) - ;; (throw key 'nil) - (setq dired-sort-last-sort (if arg - 'oldest - 'newest)) - (message "Dired-sort: Now sorted by date, %s first." - (if arg - "oldest" - "newest"))) - -(defun dired-sort-by-name (&optional arg skip-to sort-by) - "In dired, sort the lines by file name. -With ARG, sorts in reverse order. SKIP-TO SORT-BY." - (interactive "P") - (or sort-by (setq sort-by 'name)) - (save-restriction - (dired-sort-narrow-to-files) - (let ((buffer-read-only nil) - (reverse-sort-p arg)) - (goto-char (point-min)) - (sort-subr - reverse-sort-p 'forward-line 'end-of-line - (function(lambda () - (dired-move-to-filename) - (cond - ((null skip-to)) - (reverse-sort-p - (let ((here (point))) - (end-of-line) - (re-search-backward - skip-to here 'move))) - ((re-search-forward - skip-to - (save-excursion (end-of-line) (point)) - 'move) - (goto-char (match-beginning 0)))) - nil))))) - (setq dired-sort-last-sort sort-by) - (message "Dired-sort: Now sorted by %s%s." sort-by - (if arg - ", in reverse order" - ""))) - -;;;###autoload -(defun dired-sort-by-type (&optional arg) - "Sort by type, ARG means reverse." - (interactive "P") - (dired-sort-by-name - arg (if arg - "[.#~]" - "[.~0-9#]+") - 'type)) - -;;;###autoload -(defun dired-sort-by-field (field) - "In dired, sort the lines by FIELD (defaults to the mode field)." - (interactive "p") - (save-restriction - (dired-sort-narrow-to-files) - (let ((buffer-read-only nil)) - (goto-char (point-min)) - (sort-fields-1 - field (point-min) (point-max) - (function(lambda () - (sort-skip-fields (1- field)) - (skip-chars-backward " ") - nil)) - nil))) - (setq dired-sort-last-sort 'fields) - (message "Dired-sort: Now sorted by %s." - (cond ((= field 1) "file mode") - ((= field 2) "number of links") - ((= field 3) "file owner") - (t (format "field #%d" field))))) - -;;;###autoload -(defun dired-sort-by-size (&optional arg) - "In dired, sort the lines by file size, largest first. -With ARG, sorts in the reverse order (smallest first). -All directories are grouped together at the head of the buffer, -and other file types are also grouped." - (interactive "P") - (let ((buffer-read-only nil) - (incr-p arg)) - (save-restriction - (dired-sort-narrow-to-files) - (goto-char (point-min)) - (sort-subr - (not incr-p) 'forward-line 'end-of-line - (if incr-p - (function (lambda () (dired-sort-line-property - 'dired-sort-by-size-increasing-key))) - (function (lambda () (dired-sort-line-property - 'dired-sort-by-size-key)))))) - (setq dired-sort-last-sort (if incr-p - 'smallest - 'largest)) - (message "Dired-sort: Now sorted by type and size, %s first." - (if incr-p - "smallest" - "largest")))) - -;;;###autoload -(defun dired-sort-resort (kind &optional args) - "In dired, change the sorting of lines. Prompt for the KIND of sorting. -Non-interactively, takes a sort-kind, and an optional argument for -the associated function. To get a list of such arguments interactively, -call dired-sort-read-resort-args. ARGS are passed to sort." - (interactive (list (dired-sort-read-resort-args))) - (if (null kind) - (setq kind dired-sort-resort-last-kind)) - (if (consp kind) - (setq args (cdr kind) kind (car kind))) - (if (symbolp kind) (setq kind (symbol-name kind))) - (apply - (or (nth 1 (assoc kind dired-sort-resort-alist)) - (error "No such sorting method: %s" kind)) - args) - (setq dired-sort-resort-last-kind (cons kind args))) - -;;;###autoload -(defun dired-sort-default-keys-dired-mode-map () - "Define default bindings to dired map." - (interactive) - (let* ((map (symbol-value 'dired-mode-map))) - (unless map - (error "dired-sort.el: [ERROR] dired is not yet loaded.")) - (define-key map "\C-cs" nil) - (define-key map "\C-cs " 'dired-sort-resort) - (define-key map "\C-css" 'dired-sort-by-size) - (define-key map "\C-csd" 'dired-sort-by-date) - (define-key map "\C-csf" 'dired-sort-by-field) - (define-key map "\C-csn" 'dired-sort-by-name) - (define-key map "\C-cst" 'dired-sort-by-type))) - -;;;###autoload -(defun dired-sort-default-keys () - "Define default bindings to dired map." - (eval-after-load "dired" - '(progn (dired-sort-default-keys-dired-mode-map)))) - -;;;###autoload -(add-hook 'dired-mode-hook 'dired-sort-default-keys 'end) - -(run-hooks 'dired-sort-load-hook) -(provide 'dired-sort) - -;;; dired-sort.el ends here diff --git a/emacs_el/tiny-tools/other/expect.el b/emacs_el/tiny-tools/other/expect.el deleted file mode 100644 index ffe3f1d..0000000 --- a/emacs_el/tiny-tools/other/expect.el +++ /dev/null @@ -1,353 +0,0 @@ -;;; expect.el --- support for external process communication - -;; This file is not part of Emacs - -;; Copyright (C) 1997 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen -;; Keywords: extensions, processes -;; -;; This file is soon to be 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 2, 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 program; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. -;; -;; Visit for more information - -;;; Commentary: - -;;; Code: - -(require 'cl) - -(eval-and-compile - ;; Old XEmacs does not have this, ignore load error - (ignore-errors (require 'timer)) - - (when (and (not (fboundp 'run-at-time)) - (locate-library "tinyliba")) - (require 'tinyliba))) - -(defvar expect-message nil - "*If non-nil, report how much data has arrived in the process buffer. -This variable is buffer-local to all Expect buffers, and should be set -inside @code{with-expect} forms.") - -(defvar expect-start nil - "If a number, start the Expect searches from that point. -If not, start searches from `(point-min)'. -This variable is typically `let' to t before calling `with-expect' -when waiting for output from a process that is already started and may -have output data.") - -(defvar expect-timeout 10 - "The number of seconds to wait before an Expect timeout element is triggered.") - -;;; Internal variables. - -(defvar expect-processes nil) -(defvar expect-asynchronous nil) -(defvar expect-process nil) ; Dynamic variable -(defvar expect-current-info nil) ; Dynamic variable - -;;; Utility macros. - -(defun expect-make-info (process message point) - (list process message point nil nil)) - -(defmacro expect-info-process (info) - `(nth 0 ,info)) - -(defmacro expect-info-message (info) - `(nth 1 ,info)) - -(defmacro expect-info-point (info) - `(nth 2 ,info)) -(defmacro expect-info-set-point (info point) - `(setcar (nthcdr 2 ,info) ,point)) - -(defmacro expect-info-sentinels (info) - `(nth 3 ,info)) -(defmacro expect-info-set-sentinels (info sentinels) - `(setcar (nthcdr 3 ,info) ,sentinels)) - -(defmacro expect-info-timer (info) - `(nth 4 ,info)) -(defmacro expect-info-set-timer (info timer) - `(setcar (nthcdr 4 ,info) ,timer)) - -(defmacro expect-info-queries (info) - `(nthcdr 5 ,info)) -(defmacro expect-info-set-queries (info queries) - `(setcdr (nthcdr 4 ,info) ,queries)) - -(defmacro expect-find-info (process) - `(assoc ,process expect-processes)) - -;;; Interface macros. - -;;;###autoload -(defmacro with-expect (program &rest forms) - "Set things up for communication with PROGRAM. -FORMS will be evaluated in the normal manner. To talk to the process, -use `expect' and `expect-send'. See the manual for full documentation. -This macro returns nil. - -If PROGRAM is a string, start that program. If PROGRAM is a list, use -the first element of that list as the program and the remainder as the -parameters. If PROGRAM is a process, talk to that process. - -PROGRAM will be started up in a new, fresh temporary buffer. The -buffer will be killed upon completion. If PROGRAM is a process, -a new buffer won't be created, and the buffer won't be killed upon -completion." - (let ((buf (make-symbol "buf")) - (point (make-symbol "point"))) - `(save-excursion - (let ((,buf (generate-new-buffer " *expect*")) - (,point (point)) - expect-process expect-current-info) - (set-buffer ,buf) - (unless (setq expect-process - (expect-start-process ,program)) - (error "Can't start program")) - (expect-setup ,point) - ,@forms - (unless (expect-info-sentinels expect-current-info) - (expect t)) - nil)))) - -(defun expect-start-process (program) - (cond - ((stringp program) - (start-process "expect" (current-buffer) program)) - ((consp program) - (apply 'start-process - "expect" (current-buffer) (car program) (cdr program))) - ((processp program) - program) - (t - (error "Illegal process spec")))) - -(defmacro with-expect-asynchronous (program &rest forms) - "Set things up for asynchronous communication with PROGRAM. -This macro behaves like `with-expect', only that `expect' calls -contained in FORMS will be evaluated asyncronously. - -See the documentation of the `with-expect' macro for documentation." - `(let ((expect-asynchronous t)) - (with-expect ,program ,@forms))) - -(defmacro expect (regexp &rest forms) - "Execute FORMS when REGEXP has arrived in the buffer." - `(expect-1 ,regexp #'(lambda () ,@forms))) - -(defmacro expect-cond (&rest clauses) - "Try each clause until one succeeds. -Each clause looks like (CONDITION BODY). CONDITION should be -a regular expression to wait for, or a process status symbol. -If CONDITION is satisfied (i. e., the data has arrived or -the process has entered the specified status), BODY will be executed." - (let (result) - (while clauses - (push (if (stringp (caar clauses)) (caar clauses) - (list 'quote (caar clauses))) - result) - (push (car `(#'(lambda () ,@(cdar clauses)))) result) - (pop clauses)) - `(expect-1 ,@(nreverse result)))) - -(defmacro expect-exit (&rest forms) - "Execute FORMS when the process has exited." - `(expect-exit-1 #'(lambda () ,@forms))) - -;;; User utility functions. - -(defmacro expect-send (string) - "Send STRING to the current buffer's process." - `(process-send-string expect-process ,string)) - -;;; Internal functions. - -(defun expect-setup (&optional point) - "Initialize Expect data, filter and sentinel." - (setq expect-current-info - (expect-make-info expect-process expect-message - (or point expect-start (point-min)))) - (push expect-current-info expect-processes) - (set-process-filter expect-process 'expect-filter) - (set-process-sentinel expect-process 'expect-sentinel) - (set-buffer (process-buffer expect-process))) - -(defun expect-shutdown (process) - "Remove Expect infestation of PROCESS." - (setq expect-processes (delq (expect-find-info process) expect-processes)) - (set-process-filter process nil) - (set-process-sentinel process nil)) - -(defun expect-kill (process) - "Kill PROCESS and its buffer." - (let ((buffer (process-buffer process))) - (when (buffer-name buffer) - (kill-buffer buffer)) - (expect-shutdown process) - (delete-process process))) - -(defun expect-wait () - "Wait until the current outstanding command has been performed." - (let ((info (expect-find-info expect-process))) - (expect-setup-timer info) - (while (and (car (expect-info-queries (expect-find-info expect-process))) - (memq (process-status expect-process) '(open run))) - (accept-process-output expect-process 1)) - (expect-cancel-timer info)) - ;; We return nil. - nil) - -(defun expect-1 (&rest clauses) - (let (entries - timeout) - (unless expect-process - (error "No expect in this buffer")) - ;; Add this clause to the list of things to be executed. - (while clauses - (if (eq (car clauses) 'timeout) - (setq timeout (cadr clauses) - clauses (cddr clauses)) - (push (list (pop clauses) (pop clauses)) - entries))) - (when timeout - (expect-info-set-timer expect-current-info - (list nil expect-timeout timeout))) - (nconc expect-current-info (list (nreverse entries))) - ;; We see whether we have to wait for the command to complete - ;; or not. - (if expect-asynchronous - nil - (expect-wait)))) - -(defun expect-exit-1 (function) - (unless expect-process - (error "No expect in this buffer")) - (let ((info (expect-find-info expect-process))) - (expect-info-set-sentinels - info - (nconc (expect-info-sentinels info) - (list function)))) - ;; We return nil. - nil) - -(defun expect-filter (process string) - "Controlling Expect function run as a process filter." - (let ((old-buffer (current-buffer)) - (expect-process process)) - (unwind-protect - (let (moving) - (set-buffer (process-buffer process)) - (setq moving (= (point) (process-mark process))) - (save-excursion - ;; Insert the text, moving the process-marker. - (goto-char (process-mark process)) - (insert string) - (set-marker (process-mark process) (point)) - ;; Do Expect things. - (expect-find-event process)) - (when (memq (process-status process) '(open run)) - (if moving (goto-char (process-mark process))))) - (when (buffer-name old-buffer) - (set-buffer old-buffer))))) - -(defun expect-sentinel (process status) - "Controlling Expect sentinel." - ;; Perhaps we're waiting for one of the process events? - (when (memq (process-status process) '(open run)) - (expect-find-event process)) - ;; We do `expect-exit' calls. - (when (eq 'exit (process-status process)) - (save-excursion - (let ((expect-process process)) - (when (and (process-buffer process) - (buffer-name (process-buffer process))) - (set-buffer (process-buffer process)) - (let ((sentinels (expect-info-sentinels (expect-find-info process)))) - (while sentinels - (save-excursion - (funcall (pop sentinels)))) - (expect-shutdown process))))))) - -(defun expect-find-event (process) - "Find (and execute) the next event." - (let* ((info (expect-find-info process)) - (point (expect-info-point info)) - (queries (expect-info-queries info)) - (clause (car queries)) - cond) - (expect-setup-timer info) - (when (expect-info-message info) - (message "Expect received %d bytes" (point-max))) - (when clause - (if (eq (caar clause) t) - ;; We have handled all queries and want to die. - (expect-kill process) - (when (> (point-max) point) - (goto-char point) - (while clause - (setq cond (caar clause)) - (when (cond - ;; Regexp - ((stringp cond) - (re-search-forward (caar clause) nil t)) - ;; Fall-through - ((eq t cond) - t) - ;; Process state - ((memq cond '(exit run stop signal open closed)) - (eq cond (process-status process))) - (t - (error "Illegal condition: %s" cond))) - (expect-cancel-timer info) - (expect-info-set-point info (point)) - (expect-info-set-queries info (cdr queries)) - (save-excursion - (funcall (cadar clause))) - (setq clause nil) - ;; More than one event may have arrived, so we try again. - (when (memq (process-status process) '(open run)) - (expect-find-event process))) - (setq clause (cdr clause)))))))) - -(defun expect-setup-timer (info) - (let ((timer (expect-info-timer info))) - (when timer - (expect-cancel-timer info) - (setcar timer (run-at-time (cadr timer) nil (caddr timer)))))) - -(defun expect-cancel-timer (info) - (when (car (expect-info-timer info)) - (ignore-errors (cancel-timer (car (expect-info-timer info)))))) - -;;; Indentation and edebug specs. - -(put 'expect 'lisp-indent-function 1) -(put 'expect 'edebug-form-spec '(form body)) -(put 'expect-exit 'lisp-indent-function 0) -(put 'expect-exit 'edebug-form-spec '(body)) -(put 'with-expect 'lisp-indent-function 1) -(put 'with-expect 'edebug-form-spec '(form body)) -(put 'with-expect-asynchronous 'lisp-indent-function 1) -(put 'with-expect-asynchronous 'edebug-form-spec '(form body)) - -(provide 'expect) - -;;; expect.el ends here diff --git a/emacs_el/tiny-tools/other/fnexpand.el b/emacs_el/tiny-tools/other/fnexpand.el deleted file mode 100644 index 26dd11b..0000000 --- a/emacs_el/tiny-tools/other/fnexpand.el +++ /dev/null @@ -1,578 +0,0 @@ -;;; fnexpand.el --- filename expansion anywhere - -;; This file is not part of Emacs - -;; Copyright (C) 1991-2007 eirik and trost - -;; Author: and -;; Adapted-By: Jari Aalto -;; Idea by: karl@cs.umb.edu -;; Keywords: tools - -;; 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 2, 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 program; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. -;; -;; Visit for more information - -;;; Install: - -;; Put this file on your Emacs-Lisp load path, add following into your -;; ~/.emacs startup file. -;; -;; (require 'fnexpand) -;; -;; or use this; your .emacs loads up a bit quicker -;; -;; (autoload 'fnexpand-complete "fnexpand" t t) -;; -;; You should also add some keybinding to use the expansion feature -;; The following example replaces seldom used original emacs binding. -;; -;; (global-set-key "\e`" 'fnexpand-complete) -;; (define-key minibuffer-local-must-match-map "\e`" 'fnexpand-complete) -;; (define-key minibuffer-local-completion-map "\e`" 'fnexpand-complete) -;; -;; If you want to expand executables, you should add following statement -;; before any require command. Loading this package slows down remarkably -;; after this though. -;; -;; (setq fnexpand-executable-enable t) -;; - -;;; Commentary: - -;; The enclosed elisp code provides completion of user names and -;; environment variables, as well as a function which does filename -;; completion "in place", in any buffer. The latter function is -;; particularly useful as the local binding of the TAB key in shell -;; mode, but it can be used in global bindings too. -;; -;; Code to do completion of $envvar and ~username in filenames -;; Code to do completion of filenames in place (e.g. in shell buffers) -;; Sample binding: -;; -;; (setq shell-mode-hook -;; (function -;; (lambda () (local-set-key "\^I" 'fnexpand-complete )))) -;; -;; -;; If you want to expand -;; -;; -;; The code that does expansion on $ and ~ only works if the $ or ~ is -;; either at the beginning of the buffer, or after "/". One result of -;; this is that file names which end in ~ are still allowed. - -;;; Change Log: - -;; May 12 1997 [jari] 19.28 v1.10 NotReleased -;; - William A. Hoffman" reported that -;; Emacs asked to save /etc/passwd buffer. -;; - Changed the code so that no direct file buffer is used any more. -;; This also inhibits reverting the contents, but since /etc/passwd -;; changes so seldom, I don't believe the revert loss can be noticed in -;; real use. -;; -;; Apr 22 1997 [jari] 19.28 v1.8-1.9 NotReleased -;; - Added advice to complete Env variables in minibuffer prompt (TAB/SPC) -;; -;; Mar 20 1997 [jari] 19.28 v1.7 Released -;; - Added new user variable fnexpand-passwd-eval-form which now reads -;; also Solaris NIS+ password table. -;; - rewrote fnexpand-complete-username -;; -;; Mar 19 1997 [jari] 19.28 v1.6 Released -;; - Added varaible fnexpand-expand-env-directories which controls -;; expand mode for directory env variables. -;; - Corrected byteComp errors. -;; -;; May 17 1996 [jari] 19.28 v1.2-1.5 Released -;; - Found this code lying around in my ~/elisp. I cannot recall where -;; did I get this file. -;; - Rewrote most of the package. Added fnexpand- prefix to every function -;; and variable. Added the executable file expanding. -;; - got rid of the redefinitions of emacs functions. Cleared the pacakge. - -;;; Code: - -(require 'assoc) - -(eval-when-compile - (require 'advice)) - -;;; ....................................................... &v-private ... - -(defconst fnexpand-version - "$Id: fnexpand.el,v 2.12 2007/05/07 10:50:05 jaalto Exp $" - "Latest RCS modification time and version number.") - -(defvar fnexpand-envvars nil - "Private, a list of environment variable names and values. -Format: '((ENV-VAR-NAME . ENAV-VAR-VALUE).") - -(defvar fnexpand-executable-file-cache nil - "Private, list of executable files. The list is updated periodically. -Format: '((FILE . 1) (FILE . 2) ..).") - -(defvar fnexpand-executable-file-cache-counter nil - "Private, incremented every time when executable file cache is asked.") - -(defvar fnexpand-yp-passwd-buffer " *fnexpand-yp-passwords*" - "Password buffer name.") - -;;; ........................................................ &v-public ... -;;; User configurable - -(defvar fnexpand-expand-env-directories nil - "If nono-nil then environment varaiables $DIR which contain -directory slash are expanded. - -Examples; when nil, suppose PROJECT holds directory - - $PROJ[TAB] --> $PROJECT - $PRIN[TAB] --> $PRINTER - -When non-nil - - $PROJ[TAB] --> /user/local/project/dbms/ - $PRIN[TAB] --> $PRINTER - -") - -(defvar fnexpand-passwd-eval-form - (cond - ((string-match "hppa\\|hpux" (emacs-version)) - '(call-process "ypcat" nil - (get-buffer-create fnexpand-yp-passwd-buffer) - nil "passwd")) - ((and (string-match "solaris" (emacs-version)) - (file-exists-p "/var/nis")) - '(call-process "niscat" nil - (get-buffer-create fnexpand-yp-passwd-buffer) - nil "passwd.org_dir")) - (t - (insert-file-contents "/etc/passwd" t) - (setq buffer-file-name nil))) ;Make sure it is not saved back - "EVAL form to readt the password file to fnexpand-yp-passwd-buffer. -HPUX 'ypcat --> ypcat passwd -Solaris 'NIS+ --> niscat passwd.org_dir -others nil --> cat /etc/passwd -") - -;;; You don't want to update cache very often... -;;; -(defvar fnexpand-executable-file-cache-update 200 - "*Counter when to update fnexpand-executable-file-cache. -Default every 200th call. See also 'fnexpand-executable-enable'.") - -(defvar fnexpand-executable-cache-no-dirs "RCS" - "*Regexp, which directories in path not to cache. Eg looking into -RCS directory makes no sense.") - -;;;###autoload -(defvar fnexpand-executable-enable nil - "*if non-nil, then try to expand executable files too. -Beware, this may be time consuming.") - -(defvar fnexpand-filename-boundary-chars "[^#$%+-9=@-Z_a-z~]" - "*Characters used to bound filenames in 'fnexpand-find-filename'.") - -(defvar fnexpand-complete-filename-look-right nil - "*If t, consider text on both sides of point in fnexpand-complete-filename.") - -;;; .................................................... compatibility ... - -(eval-and-compile - (cond - ((fboundp 'read-file-name-internal-primitive) - (defalias 'fnexpand-read-file-name-internal-primitive - 'read-file-name-internal-primitive)) - (t - (defalias 'fnexpand-read-file-name-internal-primitive - (symbol-function 'read-file-name-internal))))) - -;;; ............................................................ funcs ... - -(defun fnexpand-getenv (&optional var) - "Return env VAR slot. If VAR is t, then update -global list 'fnexpand-envvars' if needed and return all variables -in format '((ENV-VAR-NAME . ENAV-VAR-VALUE) (E-NAME. E-VAL) ..)" - (cond - ((eq t var) - (if fnexpand-envvars - fnexpand-envvars ;read from cache - (setq fnexpand-envvars - (mapcar - (function - (lambda (string) - (let ((d (string-match "=" string))) - (cons (substring string 0 d) - (and d (substring string (1+ d))))))) - process-environment)))) - (t - (getenv var)))) - -(defun fnexpand-read-file-name-internal (name dir action) - "Like 'read-file-name-internal' that expands partial usernames and -environment variable names. - -NAME is the filename to complete; DIR is the directory to complete in. -ACTION is nil to complete, t to return list of completions, lambda to -verify final value." - (let* ((buf (current-buffer)) - (char (progn - (set-buffer (get-buffer-create " *read*")) - (erase-buffer) - (insert name) - (and (re-search-backward "[$~]" nil t) - (char-after (point))))) - (can (and char - (or (eq (point) (point-min)) - (save-excursion (backward-char 1) - (looking-at "/"))) - (not (progn - (forward-char 1) - (save-excursion - (search-forward "/" - (point-max) t)))) - (buffer-substring (point) (point-max))))) - (set-buffer buf) - (if (null can) (fnexpand-read-file-name-internal-primitive - name dir action) - (let ((prefix (substring name 0 (- (length name) (length can) 1)))) - (cond - ((eq char ?~) - (let ((s (fnexpand-complete-username can nil action))) - (cond ((stringp s) - (concat "~" s - (and - (eq t (fnexpand-complete-username s nil action)) - (file-directory-p - (expand-file-name (concat "~" s))) - "/"))) - ((eq t s) (concat name - (if (file-directory-p - (expand-file-name name)) - "/"))) - (t s)))) - ((eq char ?$) - (let ((completion-list - (all-completions - can (fnexpand-getenv t)))) - (cond - ((null action) - (let* ((un (and (eq (length completion-list) 1) - (car completion-list))) - (unv (and un (fnexpand-getenv un))) - (dirp (and unv (> (length unv) 0) - (file-directory-p unv) - "/"))) - (if (and un (string-equal un can)) - (concat prefix unv dirp) - (let ((s (try-completion can (fnexpand-getenv t))) - exp) - (cond - ((stringp s) - (setq exp (getenv s)) - (if (or (null fnexpand-expand-env-directories) - (not (string-match "/" exp))) - (concat prefix "$" s dirp) - (concat prefix exp dirp))) - (t - s)))))) - ((eq t action) - completion-list) - (t - (eq 1 (length completion-list))))))))))) - -(defun fnexpand-find-completing-names (string predicate yp-p) - "Looking for USERNAME completions matching PREDICATE (if non-nil) in current -buffer. Does not do save-excursion. If third argument YP-P is non-nil, allow -matches for individual yp entries as well." - (let ((regexp (concat (if yp-p "^+?" "^") string "[^:]*:")) - ret) - (goto-char (point-min)) - (while (re-search-forward regexp () t) - (let ((name (buffer-substring (match-beginning 0) (1- (match-end 0))))) - (if (or (not predicate) (funcall predicate name)) - (setq ret (cons (if (eq (string-to-char name) ?+) - (substring name 1) - name) - ret))) - (end-of-line))) - ret)) - -(defun fnexpand-complete-username (string predicate flag) - "Use passwd file to expand a ~. A \"+\" at the beginning of the -line is assumed to indicate a yp entry." - (let* ((buffer "*passwd*") - (pwbuf (get-buffer buffer)) - yp-p - list) - (if (string-match ":" string) - nil - (save-excursion - (cond - (pwbuf - (set-buffer pwbuf)) - (t - (set-buffer (get-buffer-create buffer)) - (insert-file-contents "/etc/passwd" t) - (setq buffer-file-name nil))) ;Make sure it is not saved back - - (goto-char (point-min)) - (cond - ((and (setq yp-p (re-search-forward "^+:" nil t)) - (null (get-buffer fnexpand-yp-passwd-buffer))) - (eval fnexpand-passwd-eval-form))) - (setq buffer-read-only t) - -;;; (d! "YP" yp-p (current-buffer) string predicate) - - (cond - ((eq flag t) - (nconc (fnexpand-find-completing-names string predicate t) - (if yp-p - (progn - (set-buffer (get-buffer fnexpand-yp-passwd-buffer)) - (fnexpand-find-completing-names - string predicate nil))))) - (flag ; should this be (eq flag 'lambda)? - (if (or (re-search-forward (concat "^+?" string ":") nil t) - (and yp-p - (progn - (set-buffer fnexpand-yp-passwd-buffer) - (re-search-forward (concat "^" string ":") nil t)))) - t)) - (t - (setq list (mapcar 'list - (fnexpand-complete-username string nil t))) - (or (and (eq (length list) 1) - (fnexpand-complete-username string predicate 'lambda)) - (try-completion string list)))))))) - -(defun fnexpand-path-list () - "Return PATH in list format '(PATH PATH ..). Only unique paths are -returned." - (let* ((path (or (getenv "PATH") - (getenv "path"))) - list - elt) - (while path - (cond - ((string-match "^[^:]+" path) - (setq elt (substring path 0 (match-end 0))) - - (if (> (length path) (match-end 0)) - (setq path (substring path (1+ (match-end 0)))) - (setq path nil)) ;no more - - ;; make sure, has ending slash - (if (not (string-match "/$" elt)) - (setq elt (concat elt "/"))) - - ;; consing is faster that append. - (if (not (member elt list)) - (setq list (cons elt list )))))) - (reverse list))) ;preserve order - -(defun fnexpand-executables (&optional verb) - "Return all unique executable files. If VERB is non-nil, print -verbose messages during updating cache. Cache is updated only -if it's nil or of cache counter reaches certain value. - -References: - 'fnexpand-executable-file-cache-counter' - 'fnexpand-executable-file-cache-update' - 'fnexpand-executable-file-cache' -" - (let* ((counter 0) - path-list - path - file - files) - - (if (integerp fnexpand-executable-file-cache-counter) - (setq fnexpand-executable-file-cache-counter - (1+ fnexpand-executable-file-cache-counter)) - (setq fnexpand-executable-file-cache-counter 0)) - - ;; time's up? update cache if needed - ;; - (cond - ((or (null fnexpand-executable-file-cache) - (eq 0 (% fnexpand-executable-file-cache-counter - fnexpand-executable-file-cache-update))) - - (setq fnexpand-executable-file-cache-counter 1 - fnexpand-executable-file-cache nil - path-list (fnexpand-path-list)) - - (while path-list - (setq path (car path-list)) - - (if verb - (message (format "fnexpand: cacheing executables %s" path))) - - (cond - ((and (not (string-match fnexpand-executable-cache-no-dirs path)) - (file-exists-p path)) ;ignore non-existing paths - (setq files (directory-files path)) - (mapcar - '(lambda (x) - (setq file (concat path x)) - - (cond - ((and (not (file-directory-p file)) - (file-executable-p file) - (not (assoc x fnexpand-executable-file-cache))) - - (setq fnexpand-executable-file-cache - (cons - (list x counter) - fnexpand-executable-file-cache )) - (setq counter (1+ counter))))) - files))) - (setq path-list (cdr path-list))) ;; while path-list - (if verb (message "")))) - - fnexpand-executable-file-cache)) - -(defun fnexpand-executable-completions (name) - "Return executable completions for NAME. If there is only one completion, -return string." - (let* ((list (fnexpand-executables 'verb)) - ret) - (setq ret (all-completions name list)) - (if (eq 1 (length ret)) - (setq ret (car ret))) - ret)) - -(defun fnexpand-find-filename () - "Return the largest substring to the left of point which can contain -a file name. Ignore the most recent prompt in a shell buffer" - (let ((mark (let ((process (get-buffer-process (current-buffer)))) - (and process (process-mark process))))) - (buffer-substring - (save-excursion - (if (re-search-backward fnexpand-filename-boundary-chars - (and mark (>= (point) mark) mark) - 1) - (1+ (point)) - (point))) - (point)))) - -;;;###autoload -(defun fnexpand-complete () - "Expand the file name, env var or command near point" - (interactive) - (and fnexpand-complete-filename-look-right - (re-search-forward fnexpand-filename-boundary-chars nil 1) - (forward-char -1)) - - (let* ((name (fnexpand-find-filename)) - (completion - (fnexpand-read-file-name-internal name default-directory nil))) - - (cond - ((eq completion t) - (insert " ")) - - ((and (null completion) ;try command name - fnexpand-executable-enable) - - (setq completion (fnexpand-executable-completions name)) - - (cond - ((stringp completion) - (delete-region (- (point) (length name)) (point)) - (insert completion)) - - ((and (listp completion) - (> (length completion) 0)) - (save-window-excursion - (with-output-to-temp-buffer " *Completions*" - (display-completion-list - completion)) - (sit-for 32767))) - (t - (message "[No match]")))) - - (completion - (if (equal completion name) - (save-window-excursion - (with-output-to-temp-buffer " *Completions*" - (display-completion-list - (fnexpand-read-file-name-internal name - default-directory t))) - (sit-for 32767)) - (unwind-protect - (if (eq t (fnexpand-read-file-name-internal - completion - default-directory - nil)) - (setq completion (concat completion " ")))) - (delete-region (- (point) (length name)) (point)) - (insert completion))) - (t (message "[No match]"))))) - -;;; ---------------------------------------------------------------------- -;;; -(defun fnexpand-env-var-complete () - "This function completes environment varaible. -It is used in minibuffer. Returns t if completion was not initiated." - (cond - ((save-excursion - (and (skip-chars-backward "^$ \t\n") - (string= (char-to-string (preceding-char)) "$"))) - (call-interactively 'fnexpand-complete) - nil) - (t - t))) - -;;; ---------------------------------------------------------------------- -;;; minibuffer's TAB key from complete.el -;;; -(defadvice PC-complete (around fnexpand act) - "Complete Envinronment variable." - (if (fnexpand-env-var-complete) ad-do-it)) - -;;; ---------------------------------------------------------------------- -;;; TAB -;;; -(defadvice minibuffer-complete (around fnexpand act) - "Complete Envinronment variables." - (if (fnexpand-env-var-complete) ad-do-it)) - -;;; ---------------------------------------------------------------------- -;;; SPACE -;;; -(defadvice PC-complete-word (around fnexpand act) - "Complete Envinronment variable." - (if (fnexpand-env-var-complete) ad-do-it)) - -;;; ---------------------------------------------------------------------- -;;; SPACE -;;; -(defadvice minibuffer-complete-word (around fnexpand act) - "Complete Envinronment variables." - (if (fnexpand-env-var-complete) ad-do-it)) - -(if fnexpand-executable-enable ;update cache immediately - (fnexpand-executables 'verb)) - -(provide 'fnexpand) - -;;; fnexpand.el ends here diff --git a/emacs_el/tiny-tools/other/folding.el b/emacs_el/tiny-tools/other/folding.el deleted file mode 100644 index 1756d39..0000000 --- a/emacs_el/tiny-tools/other/folding.el +++ /dev/null @@ -1,5364 +0,0 @@ -;;; folding.el --- A folding-editor-like minor mode. - -;; This file is not part of Emacs - -;; Copyright (C) 2000-2007 -;; Jari Aalto -;; Copyright (C) 1995-1999 -;; Jari Aalto, Anders Lindgren. -;; Copyright (C) 1994 -;; Jari Aalto -;; Copyright (C) 1992, 1993 -;; Jamie Lokier, All rights reserved. -;; -;; Author: Jamie Lokier -;; Jari Aalto -;; Anders Lindgren -;; Maintainer: Jari Aalto -;; Created: 1992 -;; Version: 2007.0506 -;; VCS-Version: $Revision: 3.42 $ -;; VCS-URL: http://nongnu.org/projects/emacs-tiny-tools/ -;; VCS-Date: $Date: 2007/05/07 10:50:05 $ -;; Keywords: tools - -;;{{{ GPL - -;; 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, -;; 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 program; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. -;; -;; Visit for more information - -;;}}} - -;;; Commentary: - -;;{{{ Introduction - -;; Preface -;; -;; This package provides a minor mode, compatible with all major -;; editing modes, for folding (hiding) parts of the edited text or -;; program. -;; -;; Folding mode handles a document as a tree, where each branch -;; is bounded by special markers `{{{' and `}}}'. A branch can be -;; placed inside another branch, creating a complete hierarchical -;; structure. -;; -;; Folding mode can CLOSE a fold, leaving only the initial `{{{' -;; and possibly a comment visible. -;; -;; It can also ENTER a fold, which means that only the current -;; fold will be visible, all text above `{{{' and below `}}}' -;; will be invisible. -;; -;; Please note, that the maintainers do not recommend to use only -;; folding for you your code layout and navigation. Folding.el is -;; on its best when it can "chunk" large sections of code inside -;; folds. The larger the chunks, the more the usability of -;; folding will increase. Folding.el is not meant to hide -;; individual functions: you may be better served by hideshow.el -;; or imenu.el (which can parse the function indexes) - -;;}}} -;;{{{ Installation - -;; Installation -;; -;; To install Folding mode, put this file (folding.el) on your -;; Emacs `load-path' (or extend the load path to include the -;; directory containing this file) and optionally byte compile it. -;; -;; The best way to install folding is the autoload installation, -;; so that folding is loaded into your emacs only when you turn on -;; `folding-mode'. This statement speeds up loading your .emacs -;; -;; (autoload 'folding-mode "folding" "Folding mode" t) -;; (autoload 'turn-off-folding-mode "folding" "Folding mode" t) -;; (autoload 'turn-on-folding-mode "folding" "Folding mode" t) -;; -;; But if you always use folding, then perhaps you want more -;; traditional installation. Here Folding mode starts -;; automatically when you load a folded file. -;; -;; ;; (setq folding-default-keys-function -;; ;; 'folding-bind-backward-compatible-keys) -;; -;; (if (load "folding" 'nomessage 'noerror) -;; (folding-mode-add-find-file-hook)) -;; -;; Folding uses a keymap which conforms with the new Emacs -;; (started 19.29) style. The key bindings are prefixed with -;; "C-c@" instead of old "C-c". To use the old keyboard bindings, -;; uncomment the lines in the the above installation example -;; -;; The same folding marks can be used in `vim' editor command -;; "set fdm=marker". -;; -;; Uninstallation -;; -;; To remove folding, call `M-x' `folding-uninstall'. -;; -;; To read the manual -;; -;; At any point you can reach the manual with `M-x' -;; `finder-commentary' RET folding RET. - -;;}}} -;;{{{ DOCUMENTATION - -;; Compatibility -;; -;; Folding supports following Emacs flavors: -;; -;; Unix Emacs 19.28+ and Win32 Emacs 19.34+ -;; Unix XEmacs 19.14+ and Win32 XEmacs 21.0+ -;; -;; Compatibility not for old NT Emacs releases -;; -;; NOTE: folding version starting from 2.47 gets around this bug -;; by using adviced kill/yank functions. The advice functions are -;; only instantiated under problematic NT Emacs versions. -;; -;; Windows NT/9x 19.34 - 20.3.1 (i386-*-nt4.0) versions contained -;; a bug which affected using folding. At the time the bug was -;; reported by Trey Jackson -;; -;; If you kill folded area and yank it back, the ^M marks are -;; removed for some reason. -;; -;; Before kill -;; ;;{{{ fold... -;; -;; After yank -;; ;;{{{ fold all lines together }}} -;; -;; Relates packages or modes -;; -;; Folding.el was designed to be a content organizer and it is most -;; suitable for big files. Sometimes people misunderstand the -;; package's capabilities and try to use folding.el in wrong places, -;; where some other package would do a better job. Trying to wrap -;; individual functions inside fold-marks is not where folding is -;; it's best. Grouping several functions inside a logical fold-block -;; in the other is. So, to choose a best tool for your need, -;; here are some suggestions,: -;; -;; o Navigating between or hiding individual functions - -;; use combination of imenu.el, speedbar.el and -;; hideshow.el -;; o Organizing large blocks - use folding.el -;; o For text, `outline-mode' is more non-intrusive than folding. -;; Look at Emacs NEWS file (`C-x' `n') and you can see beatifully -;; laid content. -;; -;; Tutorial -;; -;; To start folding mode, give the command: `M-x' `folding-mode' -;; `RET'. The mode line should contain the string "Fld" indicating -;; that folding mode is activated. -;; -;; When loading a document containing fold marks, Folding mode is -;; automatically started and all folds are closed. For example when -;; loading my init file, only the following lines (plus a few lines -;; of comments) are visible: -;; -;; ;;{{{ General... -;; ;;{{{ Keyboard... -;; ;;{{{ Packages... -;; ;;{{{ Major modes... -;; ;;{{{ Minor modes... -;; ;;{{{ Debug... -;; -;; To enter a fold, use `C-c @ >'. To show it without entering, -;; use `C-c @ C-s', which produces this display: -;; -;; ;;{{{ Minor modes -;; -;; ;;{{{ Follow mode... -;; ;;{{{ Font-lock mode... -;; ;;{{{ Folding... -;; -;; ;;}}} -;; -;; To show everything, just as the file would look like if -;; Folding mode hadn't been activated, give the command `M-x' -;; `folding-open-buffer' `RET', normally bound to `C-c' `@' -;; `C-o'. To close all folds and go to the top level, the -;; command `folding-whole-buffer' could be used. -;; -;; Mouse support -;; -;; Folding mode v2.0 introduced mouse support. Folds can be shown -;; or hidden by simply clicking on a fold mark using mouse button -;; 3. The mouse routines have been designed to call the original -;; function bound to button 3 when the user didn't click on a -;; fold mark. -;; -;; The menu -;; -;; A menu is placed in the "Tools" menu. Should no Tools menu exist -;; (Emacs 19.28) the menu will be placed in the menu bar. -;; -;; ISearch -;; -;; When searching using the incremental search (C-s) facilities, -;; folds will be automagically entered and closed. -;; -;; Problems -;; -;; Uneven fold marks -;; -;; Oops, I just deleted some text, and a fold mark got deleted! -;; What should I do? Trust me, you will eventually do this -;; sometime. the easiest way is to open the buffer using -;; `folding-open-buffer' (C-c @ C-o) and add the fold mark by -;; hand. To find mismatching fold marks, the package `occur' is -;; useful. The command: -;; -;; M-x occur RET {{{\|}}} RET -;; -;; will extract all lines containing folding marks and present -;; them in a separate buffer. -;; -;; Even though all folding marks are correct, Folding mode -;; sometimes gets confused, especially when entering and leaving -;; folds very often. To get it back on track, press C-g a few -;; times and give the command `folding-open-buffer' (C-c @ C-o). -;; -;; Fold must have a label -;; -;; When you make a fold, be sure to write some text for the name -;; of the fold, otherwise there may be an error "extraneous fold -;; mark..." Write like this: -;; -;; ;;{{{ Note -;; ;;}}} -;; -;; instead of -;; -;; ;;{{{ -;; ;;}}} -;; -;; folding-whole-buffer doesn't fold whole buffer -;; -;; If you call commands `folding-open-buffer' and -;; `folding-whole-buffer' and notice that there are open fold -;; sections in the buffer, then you have mismatch of folds -;; somewhere. Run ` M-x' `occur' and type regexp `{{{\|}}}' to -;; check where is the extra open or closing fold mark. -;; -;; Folding and outline modes -;; -;; Folding mode is not the same as Outline mode, a major and -;; minor mode which is part of the Emacs distribution. The two -;; packages do, however, resemble each other very much. The main -;; differences between the two packages are: -;; -;; o Folding mode uses explicit marks, `{{{' and `}}}', to -;; mark the beginning and the end of a branch. -;; Outline, on the other other hand, tries to use already -;; existing marks, like the `\section' string in a TeX -;; document. -;; -;; o Outline mode has no end marker which means that it is -;; impossible for text to follow a sub-branch. -;; -;; o Folding mode use the same markers for branches on all depths, -;; Outline mode requires that marks should be longer the -;; further, down in the tree you go, e.g `\chap', \section', -;; `\subsection', `\subsubsection'. This is needed to -;; distinguish the next mark at the current or higher levels -;; from a sub-branch, a problem caused by the lack of -;; end-markers. -;; -;; o Folding mode has mouse support, you can navigate through a -;; folded document by clicking on fold marks. (The XEmacs version -;; of Outline mode has mouse support.) -;; -;; o The Isearch facilities of Folding is capable of -;; automatically to open folds. Under Outline, the the entire -;; document must be opened prior isearch. -;; -;; In conclusion, Outline mode is useful when the document being -;; edited contains natural markers, like LaTeX. When writing code -;; natural markers are hard to find, except if you're happy with -;; one function per fold. -;; -;; Future development ideas -;; -;; The plan was from the beginning to rewrite the entire package. -;; Including replacing the core of the program, written using -;; old Emacs technology (selective display), and replace it with -;; modern equivalences, like overlays or text-properties for -;; Emacs and extents for XEmacs. -;; -;; It is not likely that any of this will come true considering -;; the time required to rewrite the core of the package. Since -;; the package, in it's current state, is much more powerful than -;; the original, it would be appropriate to write such package -;; from scratch instead of doing surgery on this one. - -;;}}} - -;;{{{ Customization - -;; Customization: general -;; -;; The behavior of Folding mode is controlled mainly by a set of -;; Emacs Lisp variables. This section will discuss the most -;; useful ones, for more details please see the code. The -;; descriptions below assumes that you know a bit about how to -;; use simple Emacs Lisp and knows how to edit ~/.emacs, your -;; init file. -;; -;; Customization: hooks -;; -;; The normal procedure when customizing a package is to write a -;; function doing the customization. The function is then added -;; to a hook which is called at an appropriate time. (Please see -;; the example section below.) The following hooks are -;; available: -;; -;; o `folding-mode-hook' -;; Called when folding mode is activated. -;; o `-folding-hook' -;; Called when starting folding mode in a buffer with major -;; mode set to . (e.g. When editing C code -;; the hook `c-mode-folding-hook' is called.) -;; o `folding-load-hook' -;; Called when folding mode is loaded into Emacs. -;; -;; Customization: The Mouse -;; -;; The variable `folding-behave-table' contains the actions which -;; should be performed when the user clicks on an open fold, a -;; closed fold etc. For example, if you prefer to `enter' a fold -;; rather than `open' it you should rebind this variable. -;; -;; The variable `folding-default-mouse-keys-function' contains -;; the name of the function used to bind your mouse keys. To use -;; your own mouse bindings, create a function, say -;; `my-folding-bind-mouse', and set this variable to it. -;; -;; Customization: Keymaps -;; -;; When Emacs 19.29 was released, the keymap was divided into -;; strict parts. (This division existed before, but a lot of -;; packages, even the ones delivered with Emacs, ignored them.) -;; -;; C-c -- Reserved for the users private keymap. -;; C-c C- -- Major mode. (Some other keys are -;; reserved as well.) -;; C-c -;; -- Reserved for minor modes. -;; -;; The reason why `C-c@' was chosen as the default prefix is that -;; it is used by outline-minor-mode. It is not likely that few -;; people will try to use folding and outline at the same time. -;; -;; However, old key bindings have been kept if possible. The -;; variable `folding-default-keys-function' specifies which -;; function should be called to bind the keys. There are various -;; function to choose from how user can select the keybindings. -;; To use the old key bindings, add the following line to your -;; init file: -;; -;; (setq folding-default-keys-function -;; 'folding-bind-backward-compatible-keys) -;; -;; To define keys similar to the keys used by Outline mode, use: -;; -;; (setq folding-default-keys-function -;; 'folding-bind-outline-compatible-keys) -;; -;; Customization: adding new major modes -;; -;; To add fold marks for a new major mode, use the function -;; `folding-add-to-marks-list'. Example: -;; -;; (folding-add-to-marks-list -;; 'c-mode "/* {{{ " "/* }}} */" " */" t) -;; (folding-add-to-marks-list -;; 'java-mode "// {{{ " "// }}}" nil t) -;; -;; Customization: ISearch -;; -;; If you don't like the extension folding.el applies to isearch, -;; set the variable `folding-isearch-install' to nil before -;; loading this package. - -;;}}} -;;{{{ Examples - -;; Example: personal setup -;; -;; To define your own key binding instead of using the standard -;; ones, you can do like this: -;; -;; (setq folding-mode-prefix-key "\C-c") -;; ;; -;; (setq folding-default-keys-function -;; '(folding-bind-backward-compatible-keys)) -;; ;; -;; (setq folding-load-hook 'my-folding-load-hook) -;; -;; -;; (defun my-folding-load-hook () -;; "Folding setup." -;; -;; (folding-install) ;; just to be sure -;; -;; ;; ............................................... markers ... -;; -;; ;; Change text-mode fold marks. Handy for quick -;; ;; sh/perl/awk code -;; -;; (defvar folding-mode-marks-alist nil) -;; -;; (let* ((ptr (assq 'text-mode folding-mode-marks-alist))) -;; (setcdr ptr (list "# {{{" "# }}}"))) -;; -;; ;; ........................................ bindings ... -;; -;; ;; Put `folding-whole-buffer' and `folding-open-buffer' -;; ;; close together. -;; -;; (defvar folding-mode-prefix-map nil) -;; -;; (define-key folding-mode-prefix-map "\C-w" nil) -;; (define-key folding-mode-prefix-map "\C-s" -;; 'folding-show-current-entry) -;; (define-key folding-mode-prefix-map "\C-p" -;; 'folding-whole-buffer)) -;; -;; Example: changing default fold marks -;; -;; In case you're not happy with the default folding marks, you -;; can change them easily. Here is an example -;; -;; (setq folding-load-hook 'my-folding-load-hook) -;; -;; (defun my-folding-load-hook () -;; "Folding vars setup." -;; (let* ((ptr (assq 'text-mode folding-mode-marks-alist))) -;; (setcdr ptr (list "# {{{" "# }}}")))) -;; -;; -;; Example: choosing different fold marks for mode -;; -;; Suppose you sometimes want to use different fold marks for the -;; major mode: e.g. to alternate between "# {{{" and "{{{" in -;; `text-mode' Call `M-x' `my-folding-text-mode-setup' to change -;; the marks. -;; -;; (defun my-folding-text-mode-setup (&optional use-custom-folding-marks) -;; (interactive -;; (list (y-or-n-p "Use Custom fold marks now? "))) -;; (let* ((ptr (assq major-mode folding-mode-marks-alist)) -;; (default-begin "# {{{") -;; (default-end "# }}}") -;; (begin "{{{") -;; (end "}}}")) -;; (when (eq major-mode 'text-mode) -;; (unless use-custom-folding-marks -;; (setq begin default-begin end default-end))) -;; (setcdr ptr (list begin end)) -;; (folding-set-marks begin end))) -;; -;; Example: AucTex setup -;; -;; Suppose you're using comment.sty with AucTeX for editing -;; LaTeX2e documents and you have these comment types. You would -;; like to be able to set which of these 3 is to be folded at any -;; one time, using a simple key sequence: move back and forth -;; easily between the different comment types, e.g., "unfold -;; everything then fold on \x". -;; -;; \O ... \endO -;; \L ... \endL -;; \B ... \endB -;; -;; (setq folding-load-hook 'my-folding-load-hook) -;; -;; (defun my-folding-load-hook () -;; "Folding vars setup." -;; (let ((ptr (assq 'text-mode folding-mode-marks-alist))) -;; (setcdr ptr (list "\\O" "\\endO")) -;; (define-key folding-mode-prefix-map "C" -;; 'my-folding-marks-change))) -;; -;; (defun my-folding-marks-change (&optional selection) -;; "Select folding marks: prefixes nil, C-u and C-u C-u." -;; (interactive "P") -;; (let ((ptr (assq major-mode folding-mode-marks-alist)) -;; input) -;; (when (string-match "^\\(plain-\\|la\\|auc\\)?tex-" -;; (symbol-name major-mode)) -;; (setq input -;; (read-string "Latex \\end(X) Marker (default O): " -;; nil nil "O" nil)) -;; (setq input (upcase input)) -;; (turn-off-folding-mode) -;; (folding-add-to-marks-list -;; major-mode -;; (concat "\\" input) (concat "\\end" input) nil nil t) -;; ;; (setcdr ptr (list (concat "\\" input) (concat "\\end" input))) -;; (turn-on-folding-mode)))) -;; ;; End of example -;; -;; Bugs: Lazy-shot.el conflict in XEmacs -;; -;; [XEmacs 20.4 lazy-shot-mode] -;; 1998-05-28 Reported by Solofo Ramangalahy -;; -;; % xemacs -q folding.el -;; M-x eval-buffer -;; M-x folding-mode -;; M-x font-lock-mode -;; M-x lazy-shot-mode -;; C-s mouse -;; -;; then search for mouse again and again. At some point you will -;; see "Deleting extent" in the minibuffer and XEmacs freezes. -;; -;; The strange point is that I have this bug only under Solaris -;; 2.5 sparc (binaries from ftp.xemacs.org) but not under Solaris -;; 2.6 x86. (XEmacs 20.4, folding 2.35). I will try to access -;; more machines to see if it's the same. -;; -;; I suspect that the culprit is lazy-shot as it is beta, but -;; maybe you will be able to describe the bug more precisely to -;; the XEmacs people I you can reproduce it. - -;;}}} -;;{{{ Old Documentation - -;; Old documentation -;; -;; The following text was written by Jamie Lokier for the release -;; of Folding V1.6. It is included here for no particular reason: -;; -;; Emacs 18: -;; Folding mode has been tested with versions 18.55 and -;; 18.58 of Emacs. -;; -;; Epoch: -;; Folding mode has been tested on Epoch 4.0p2. -;; -;; [X]Emacs: -;; There is code in here to handle some aspects of XEmacs. -;; However, up to version 19.6, there appears to be no way to -;; display folds. Selective-display does not work, and neither do -;; invisible extents, so Folding mode has no chance of -;; working. This is likely to change in future versions of -;; XEmacs. -;; -;; Emacs 19: -;; Tested on version 19.8, appears to be fine. Minor bug: -;; display the buffer in several different frames, then move in -;; and out of folds in the buffer. The frames are automatically -;; moved to the top of the stacking order. -;; -;; Some of the code is quite horrible, generally in order to -;; avoid some Emacs display "features". Some of it is specific to -;; certain versions of Emacs. By the time Emacs 19 is around and -;; everyone is using it, hopefully most of it won't be necessary. -;; -;; More known bugs -;; -;; *** Needs folding-fold-region to be more intelligent about -;; finding a good region. Check folding a whole current fold. -;; -;; *** Now works with 19! But check out what happens when you -;; exit a fold with the file displayed in two frames. Both -;; windows get fronted. Better fix that sometime. -;; -;; Future features -;; -;; *** I will add a `folding-next-error' sometime. It will only -;; work with Emacs versions later than 18.58, because compile.el -;; in earlier versions does not count line-numbers in the right -;; way, when selective display is active. -;; -;; *** Fold titles should be optionally allowed on the closing -;; fold marks, and `folding-tidy-inside' should check that the -;; opening title matches the closing title. -;; -;; *** `folded-file' set in the local variables at the end of a -;; file could encode the type of fold marks used in that file, -;; and other things, like the margins inside folds. -;; -;; *** I can see a lot of use for the newer features of Emacs 19: -;; -;; Using invisible text-properties (I hope they are intended to -;; make text invisible; it isn't implemented like that yet), it -;; will be possible to hide folded text without affecting the -;; text of the buffer. At the moment, Folding mode uses selective -;; display to hide text, which involves substituting -;; carriage-returns for line-feeds in the buffer. This isn't such -;; a good way. It may also be possible to display different folds -;; in different windows in Emacs 19. -;; -;; Using even more text-properties, it may be possible to track -;; pointer movements in and out of folds, and have Folding mode -;; automatically enter or exit folds as necessary to maintain a -;; sensible display. Because the text itself is not modified (if -;; overlays are used to hide text), this is quite safe. It would -;; make it unnecessary to provide functions like -;; `folding-forward-char', `folding-goto-line' or -;; `folding-next-error', and things like I-search would -;; automatically move in and out of folds as necessary. -;; -;; Yet more text-properties/overlays might make it possible to -;; avoid using narrowing. This might allow some major modes to -;; indent text properly, e.g., C++ mode. - -;;}}} - -;;; Change Log: - -;;{{{ History -;; [person version] = developer and his revision tree number. -;; -;; May 06 2007 21.4 [jari 3.38-3.41 2007.0506] -;; - Cleanup. Eol whitespaces removed, extra newlines cleaned. -;; Paren positions corrected. -;; - 'Personal reflections by Anders Lindgren' topic -;; rephrased 'Future development ideas' -;; -;; Nov 16 2006 21.4 [jari 3.36-3.37 2006.1118] -;; - Jeremy Hankins sent a patch, which -;; adds variable `folding-narrow-by-default'. The patch affects -;; mostly `folding-shift-in'. This makes it possible to -;; advise viper-search to open folds. Thanks. -;; - Added VCS URL header to the beginning for canonnical location. -;; Updated maintainer section. -;; - Fixed Copyright years. -;; -;; Nov 25 2004 21.3 [jari 3.35 2004.1125] -;; - non-ascii character removed from bibtex-mode. -;; Changed bib-mode '@comment' => '%'. Closes Debian -;; Bug#282388 -;; -;; Sep 10 2004 21.3 [jari 2.116 2004.0910] -;; - (folding-fold-region): caused to indent bottom fold -;; some 50 spaces forward in auctex:latex-mode. Disabled -;; running `indent-according-to-mode' while in latex-mode. -;; Bug reported by Uwe Brauer; oub A T mat dot ucm dot es -;; - Removed extra newlines from whole buffer. -;; - Changed version scheme to date based YYYY.MMDD -;; - Removed unnecessary 'all rights reserved'. -;; - (folding-check-folded): Added check for \r character, which -;; - protected all email addresses by removing AT-signs. -;; -;; Apr 01 2004 21.3 [jari 2.111-2.115] -;; - Merged in changes made by 2003-11-12 Adrian Aichner -;; from XEmacs tree 1.15; Typo fixes for docstrings and comments. -;; - Returned to old bug and solved it in a better way (preserve region) by -;; using different expansion macros for XEmacs and Emacs. -;; See See http://list-archive.xemacs.org/xemacs-beta/199810/msg00039.html -;; - (folding-forward-char-1): 2.112 Renamed. -;; Was `folding-forward-char'. -;; (folding-backward-char-1): 2.112 Renamed. -;; Was `folding-backward-char'. -;; (folding-forward-char-macro): 2.112 New. Fix XEmacs -;; region preservation with '_p' interactive spec. -;; (folding-backward-char-macro): 2.112 New. Fix XEmacs -;; region preservation with '_p' interactive spec. -;; (folding-interactive-spec-p): 2.112 New. -;; -;; Sep 11 2003 21.2 [jari 2.107-2.111] -;; - Added new sections "Uninstallation" and "To read the manual". -;; M-x finder can invoke folding too provided that patch to -;; lisp-mnt.el and finder.el is installed. Sent patch to XEmacs and -;; Emacs developers. -;; - Moved fold-mark ";;{{{ Introduction" after the Commentary: -;; tag to have it included in M-x finder-commentary. -;; - If called like this: `folding-uninstall' and immediately -;; `folding-mode', the keybindings were not there any more. Added -;; call to `folding-install' in `folding-mode'. -;; - Completely rewrote `folding-install'. It's now divided into -;; `folding-install-keymaps' and `folding-uninstall-keymaps' -;; - Added support for `php-mode', `javascript-mode', -;; `change-log-mode' and `finder-mode'. -;; - Documentation changes (fit all to 80 characters). -;; -;; Aug 21 2002 21.2 [jari 2.105-2.106] -;; - Added user function `folding-uninstall'. -;; - Removed `interactive' status: `folding-install-hooks' and -;; `folding-uninstall-hooks' -;; -;; Aug 02 2002 20.7 [jari 2.101-2.104] -;; - Added font lock support. Now beginning and end markers are -;; highlighted with user variables `folding-font-lock-begin-mark' -;; `folding-font-lock-end-mark'. Feature suggested by -;; -;; - Removed LCD entry - unnecessary. -;; -;; Jan 24 2002 20.7 [jari 2.100] -;; - (folding-context-next-action):New user function. -;; Code by Scott Evans -;; - (folding-bind-default-keys): Added -;; C-x . to run `folding-context-next-action' -;; - (folding-mouse-call-original): Added `car-safe' to read -;; EVENT, which may be nil. -;; -;; Jul 31 2001 20.7 [jari 2.98-2.99] -;; - Gleb Arshinov fixed the broken XEmacs -;; isearch support and sent nice patch. -;; -;; Jul 19 2001 20.7 [jari 2.92-2.97] -;; - Beautified lisp code by removing parens that were alone. -;; - XEmacs latex-mode fix. The folds were strangely indented too -;; far right. The cause was `indent-according-to-mode' which is -;; now disabled in latex. bug reported by -;; Uwe Brauer; oub A T maraton sim ucm es -;; - 2.96 Erroneous `:' in `folding-mode-write-file' -;; when it should have been `;'. Bug reported by -;; Brand Michael; michael brand A T siemens com -;; -;; Apr 04 2001 20.7 [jari 2.89-2.91] -;; - Small corrections to find-func.el::find-function-search-for-symbol -;; implementation. -;; -;; Mar 08 2001 20.6 [jari 2.88] -;; - Dave Masterson reported that jumping to a -;; url displayed by the C-h f FUNCTION which told where the function -;; was located died. The reason was that the buffer was folded and -;; find-func.el::find-function-search-for-symbol used regexps that -;; do not take into account folded buffers. The regexps used there -;; rely on syntax tables. -;; - Added two new advices to catch find-func.el and unfold the buffer -;; prior searching: (advice find-file-noselect after) and (advice -;; find-function-search-for-symbol around) -;; -;; Mar 04 2001 20.6 [jari 2.83-2.87] -;; - Added ###autoload statements, tidied up empty lines and lisp syntax. -;; - Run checkdoc.el 0.6.1 and corrected errors. -;; -;; Jan 04 2001 20.6 [jari 2.82] -;; - Added FOLD highlight feature for XEmacs: -;; `folding-mode-motion-highlight-fold' -;; and package `mode-motion' Suggested by -;; Thomas Ruhnau -;; - (folding-bind-default-keys): 2.81 New binding C-k -;; `folding-marks-kill' -;; (fold-marks-kill): 2.81 New. -;; -;; Jan 03 2001 20.6 [jari 2.81] -;; - (folding-folding-region): 2.80 Renamed to `folding-fold-region' -;; - (folding-mark-look-at-top-mark-p): 2.80 New. -;; - (folding-mark-look-at-bottom-mark-p): 2.80 New. -;; - (folding-tidy-inside): 2.80 Use `folding-mark-look-at-top-mark-p' -;; and `folding-mark-look-at-bottom-mark-p'. -;; - Didn't accept spaces in front of fold markers. -;; - (folding-fold-region): 2.80 Added `indent-according-to-mode' -;; to indent folds as needed. -;; -;; Dec 16 2000 20.6 [jari 2.79-2.80] -;; - `folding-xemacs-p' now test (featurep 'xemacs) -;; - Added missing folding functions to the menubar -;; - `folding-package-url-location' new variable used by function -;; `folding-insert-advertise-folding-mode' -;; - `folding-keep-hooked' was commented out in `folding-mode'. Added -;; back. -;; -;; Jul 25 2000 20.6 [jari 2.76-2.78] -;; - 2.75 Added support for modes: -;; xrdb-mode, ksh-mode and sql-mode contributed by -;; Juhapekka Tolvanen . Scanned systematically -;; all modes under Emacs 20.6 progmodes and added support for: -;; ada-mode, asm-mode, awk-mode, cperl-mode, fortran-mode, f90-mode, -;; icon-mode, m4-mode, meta-mode, pascal-mode, prolog-mode, -;; simula-mode, vhdl-mode, bibtex-mode, nroff-mode, scribe-mode(*), -;; sgml-mode -;; - Mode marked with (*) was not added. -;; - (folding-insert-advertise-folding-mode): 2.76 New. Suggested by -;; Juhapekka Tolvanen -;; - (folding-bind-default-keys): 2.76 -;; folding-insert-advertise-folding-mode Bound to key "I" -;; -;; Apr 24 1999 20.4 [jari 2.73-2.75] -;; - (folding-bind-terminal-keys): 2.74 New. Bind C-f and C-b only at -;; non-window system where they are really needed. Someone may use -;; C-f for `isearch-forward' in windowed Emacs. -;; - (folding-bind-default-keys): 2.74 Use `folding-bind-terminal-keys' -;; - (folding-bind-outline-compatible-keys): 2.74 -;; Use `folding-bind-terminal-keys' -;; -;; Feb 13 1999 20.4 [jari 2.71-2.72] -;; - (folding-event-posn): 2.70 Wrong -;; place of paren and the following was malformed call: -;; (let* ((el (funcall (symbol-function 'event-start) event))) -;; -;; Jan 13 1999 20.4 [jari 2.70] -;; - 2.69 The `looking-at' is now smarter with -;; fold beginning marks. The tradition has been the the fold always -;; has a name, so the requirement to search fold is "{{{ ". Now -;; the " " is searched as " *", not requiring a space --> not requiring -;; a fold name. -;; - (folding-skip-folds): >>feature not not enabled<< -;; 2.69 Do not require trailing " " any more.' -;; (folding-tidy-inside): >>feature not not enabled<< -;; 2.69 Do not require trailing " " any more. -;; - (folding-install): 2.69 Fixed indentation. -;; - (folding-mark-look-at): 2.69 The "em" missed "*" and thus pressing -;; mouse-3 at the end-fold didn't collapse the whole fold. -;; -;; Jan 12 1999 20.4 [jari 2.69] -;; (folding-bind-default-mouse): 2.68 -;; XEmacs and Emacs Mouse binding was different. Now use common -;; bindings: The S-mouse-2 was superfluous, because mouse-3 already -;; did that, so the binding was removed. -;; mouse-3 folding-mouse-context-sensitive -;; S-mouse-2 folding-hide-current-entry -;; C-S-mouse-2 folding-mouse-pick-move -;; -;;;; Jan 09 1999 20.4 [jari 2.67-2.68] -;; - (folding-event-posn): 2.66 Hide `event-start' From XEmacs -;; (byte compile silencer) -;; -;; Jan 07 1999 20.4 [jari 2.65-2.66] -;; - The Folding begin and AND mark was not case sensitive; -;; that's why a latex styles "\B" and "\endB" fold marks couldn't -;; be used. Added relevant `case-fold-search' settings. Not tested -;; very well, though. -;; - Added standard "turn-on" "turn-off" functions. -;; - (folding-whole-buffer): 2.65 Better -;; Error message. Show used folding-mark on error. -;; - (folding-skip-folds): 2.65 Moved docs in function. -;; - (turn-off-folding-mode): 2.65 New. -;; - (turn-on-folding-mode): 2.65 New. -;; - (folding-mark-look-at): 2.65 `case-fold-search' -;; - (folding-next-visible-heading): 2.65 `case-fold-search' -;; - (folding-find-folding-mark): 2.65 `case-fold-search' -;; - (folding-pick-move): 2.65 `case-fold-search' -;; - (folding-skip-folds): 2.65 `case-fold-search' -;; - (folding-tidy-inside): 2.65 `case-fold-search' -;; - (folding-convert-to-major-folds): 2.65 `case-fold-search' -;; -;; Jan 04 1999 20.4 [jari 2.62-2.64] -;; - (folding-set-local-variables): 2.61 New. Now it is possible to -;; change the folding marks dynamically. -;; - (folding-mode): 2.61 Call `folding-set-local-variables' -;; (folding-mode-marks-alist): 2.61 mention -;; - `folding-set-local-variables' -;; Added documentation section: "Example: AucTex setup" -;; - NT Emacs fix wrapped inside `eval-and-compile'. hs-discard-overlays -;; are now hidden from byte compiler (since the code is not -;; executed anyway) -;; -;; May 24 1999 19.34 [jari 2.59-2.61] -;; - New function `folding-all-comment-blocks-in-region'. Requested by -;; Uwe Brauer . Bound under "/" key. -;; - (folding-all-comment-blocks-in-region): -;; Check non-whitespace `comment-end'. Added `matlab-mode' to -;; fold list -;; - (folding-event-posn): 2.63 Got rid of the XEmacs/Emacs -;; posn-/event- byte compiler warnings -;; - (folding-mouse-call-original): 2.63 Got rid of the XEmacs -;; `event-button' byte compiler warning. -;; -;; Apr 15 1999 19.34 [jari 2.57] -;; - (folding-mouse-call-original): Samuel Mikes -;; reported that the `concat' function was -;; used to add an integer to "button" event. Applied patch to use -;; `format' instead. -;; -;; Mar 03 1999 19.34 [andersl] -;; - (folding-install): had extra paren. Removed. -;; -;; Feb 22 1999 19.34 [jari 2.56] -;; - folding-install): -;; Check if `folding-mode-prefix-map' is nil and call -;; -;; Feb 19 1999 19.34 [jari 2.55] -;; - (folding-mode-hook-no-re): -;; Renamed to `folding-mode-hook-no-regexp' -;; - (fold-inside-mode-name): Renames to `folding-inside-mode-name' -;; (fold-mode-string): Renamed to `folding-mode-string' -;; - Renamed all `fold-' prefixes to `folding-' -;; - Rewrote chapter `Example: personal setup' -;; -;; Jan 01 1999 19.34 [jari 2.54] -;; - Byte compiler error fix: (folding-bind-outline-compatible-keys): -;; 'folding-show-all lacked the quote. -;; -;; Dec 30 1998 19.34 [jari 2.53] -;; - Jesper Pedersen reported bug that hiding -;; subtree was broken. This turned out to be a bigger problem in fold -;; handling in general. This release has big relatively big error -;; fixes. -;; - Many of the folding functions were also renamed to mimic Emacs 20.3 -;; allout.el names. Outline keybindings were rewritten too. -;; - folding.el (folding-mouse-yank-at-point): Renamed from -;; `folding-mouse-operate-at-point'. The name is similar to Emacs -;; standard variable name. The default value changed from nil --> t -;; according to suggestion by Jesper Pedersen -;; Message "Info, Ignore [X]Emacs specific..." is now displayed only -;; while byte compiling file. -;; (folding-bind-outline-compatible-keys): -;; Checked the Emacs 20.3 allout.el outline bindings and made -;; folding mimic them -;; (folding-show-subtree): Renamed to `folding-show-current-subtree' -;; according to allout.el -;; (folding-hide-subtree): Renamed to `folding-hide-current-subtree' -;; according to allout.el -;; (folding-enter): Renamed to `folding-shift-in' -;; according to allout.el -;; (folding-exit): Renamed to `folding-shift-out' -;; according to allout.el -;; (folding-move-up): Renamed to `folding-previous-visible-heading' -;; according to allout.el -;; (folding-move): Renamed to `folding-next-visible-heading' -;; according to allout.el -;; (folding-top-level): Renamed to `folding-show-all' -;; according to allout.el -;; (folding-show): Renamed to `folding-show-current-entry' -;; according to allout.el -;; (folding-hide): Renamed to `folding-hide-current-entry' -;; according to allout.el -;; (folding-region-open-close): While loop rewritten so that if user -;; is already on a fold mark, then close current fold. This also -;; fixed the show/hide subtree problem. -;; (folding-hide-current-subtree): If use hide subtree that only had -;; one fold, then calling this function caused error. The reason was -;; error in `folding-pick-move' (folding-pick-move): Test that -;; `moved' variable is integer and only then move point. This is the -;; status indicator from `folding-find-folding-mark' -;; (folding-find-folding-mark): Fixed. mistakenly moved point when -;; checking TOP level marker, status 11. the point was permanently -;; moved to point-min. -;; -;; Dec 29 1998 19.34 [jari 2.51] -;; - Jesper Pedersen reported that prefix key -;; cannot take vector notation [(key)]. This required changing the way -;; how folding maps the keys. Now uses intermediate keymap -;; `folding-mode-prefix-map' -;; - `folding-kbd' is new. -;; - `folding-mode' function description has better layout. -;; - `folding-get-mode-marks' is now defsubst. -;; -;; Dec 13 1998 19.34 [jari 2.49-2.50] -;; - Gleb Arshinov reported that the XEmacs 21.0 -;; `concat' function won't accept integer argument any more and -;; provided patch for `folding-set-mode-line'. -;; -;; Nov 28 1998 19.34 [jari 2.49-2.50] -;; - Gleb Arshinov reported that the -;; zmacs-region-stays must not be set globally but in the functions -;; that need it. He tested the change on tested on XEmacs 21.0 beta -;; and FSF Emacs 19.34.6 on NT and sent a patch . Thank you. -;; - (folding-preserve-active-region): New macro to set -;; `zmacs-region-stays' to t in XEmacs. -;; - (folding-forward-char): Use `folding-preserve-active-region' -;; - (folding-backward-char): Use `folding-preserve-active-region' -;; - (folding-end-of-line): Use `folding-preserve-active-region' -;; - (folding-isearch-general): Variables `is-fold' and -;; `is narrowed' removed, because they were not used. (Byte -;; Compilation fix) -;; - Later: interestingly using `defmacro' -;; folding-preserve-active-region does not work in XEmacs 21.0 beta, -;; but `defsubst' does. Reported and corrected by Gleb. -;; -;; Oct 22 1998 19.34 [jari 2.47-2.48] -;; - NT Emacs has had long time a bug where it strips away ^M when -;; closed fold is copied to kill ring. When pasted, then ^M are -;; gone. This cover NT Emacs releases 19.34 - 20.3. Bug report has -;; been filed. -;; - to cope with the situation I added new advice functions that -;; get instantiated only for these versions of NT Emacs. See -;; `kill-new' and `current-kill' -;; -;; Oct 21 1998 19.34 [jari 2.46] -;; - `folding-isearch-general' now enters folds as usual with isearch. -;; The only test needed was to check `quit-isearch' before calling -;; `folding-goto-char', because the narrow case was already taken -;; cared of in the condition case. -;; -;; Oct 19 1998 19.34 [jari 2.44] -;; - 1998-10-19 Uwe Brauer reported that -;; In Netscape version > 4 the {{{ marks cannot be used. For IE they -;; were fine, but not for Netscape. Some bug there. -;; --> Marks changed to [[[ ]]] -;; -;; Oct 5 1998 19.34 [jari 2.43] -;; - The "_p" flag does not exist in Emacs 19.34, so the previous patch -;; was removed. (Greg Klanderman) suggested using -;; `zmacs-region-stays'. Added to the beginning of file. -;; - todo: folding does not seem to open folds any more with Isearch. -;; -;; Oct 5 1998 19.34 [jari 2.42] -;; - Gleb Arshinov reported (and supplied patch): -;; I am using the latest beta of folding.el with XEmacs 21.0 "Finnish -;; Landrace" [Lucid] (i386-pc-win32) (same bug is present with folding.el -;; included with XEmacs). Being a big fan of zmacs-region, I was -;; disappointed to find that folding mode caused my usual way of -;; selecting regions (e.g. to select a line C-space, C-a, C-e) to break -;; :( I discovered that the following 3 functions would unset my mark. -;; Upon reading some documentation, this seems to be caused by an -;; argument to interactive used by these functions. With the following -;; tiny patch, the undesirable behaviour is gone. -;; - Patch was applied as is. Function affected: -;; `folding-forward-char' `folding-backward-char' -;; `folding-end-of-line'. Interactive spec changed from "p" to "_p" -;; -;; Sep 28 1998 19.34 [jari 2.41] -;; - Wrote section "folding-whole-buffer doesn't fold whole buffer" to -;; Problems topic. Fixed some indentation in documentation so that -;; command ripdoc.pl folding.el | t2html.pl --simple > folding.html -;; works properly. -;; -;; Sep 24 1998 19.34 [jari 2.40] -;; - Stephen Smith wished that the -;; `folding-comment-fold' should handle modes that have comment-start -;; and comment-end too. That lead to rewriting the comment function so -;; that it can be adapted to new modes. -;; - `folding-pick-move' didn't work in C-mode. Fixed. -;; (folding-find-folding-mark): -;; m and re must be protected with `regexp-quote'. This -;; corrected error eg. in C-mode where `folding-pick-move' -;; didn't move at all. -;; (folding-comment-fold): Added support for major modes that -;; have `comment-start' and `comment-end'. Use -;; `folding-comment-folding-table' -;; (folding-comment-c-mode): New. -;; (folding-uncomment-c-mode): New. -;; (folding-comment-folding-table): New. To adapt to any major-mode. -;; (folding-uncomment-mode-generic): New. -;; (folding-comment-mode-generic): New. -;; -;; Aug 08 1998 19.34 [jari 2.39] -;; - Andrew Maccormack reported that the -;; `em' end marker that was defined in the `let' should also have -;; `[ \t\n]' which is in par with the `bm'. This way fold markers do -;; not need to be parked to the left any more. -;; -;; Jun 05 1998 19.34 [jari 2.37-2.38] -;; - Alf-Ivar Holm send functions -;; `folding-toggle-enter-exit' and `folding-toggle-show-hide' which -;; were integrated. Alf also suggested that Fold marks should now -;; necessarily be located at the beginning of line, but allow spaces -;; at front. The patch was applied to `folding-mark-look-at' -;; -;; Mar 17 1998 19.34 [Anders] -;; - Anders: This patch fixes one problem that was reported in the -;; beginning of May by Ryszard Kubiak . -;; - Finally, I think that I have gotten mouse-context-sensitive -;; right. Now, when you click on a fold that fold rather than the -;; one the cursor is on is used, while still not breaking commands -;; like `mouse-save-then-kill' which assumes that the point hasn't -;; been moved. -;; - Jari: Added topic "Fold must have a label" to the Problem section. -;; as reported by Solofo Ramangalahy -;; - 1998-05-04 Ryszard Kubiak reported: I am -;; just curious if it is possible to make Emacs' cursor -;; automatically follow a mouse-click on the {{{ and }}} lines. I -;; mean by this that a [S-mouse-3] (as defined in my settings below -;; --- I keep not liking overloading [mouse-3]) first moves the -;; cursor to where the click happened and then hides or shows a -;; folded area. I presume that i can write a two-lines long -;; interactive function to do this. Still, may be this kind of mouse -;; behaviour is already available. -;; -;; Mar 17 1998 19.34 [Jari 2.34-2.35] -;; - Added "Example: choosing different fold marks for mode" -;; - corrected `my-folding-text-mode-setup' example. -;; -;; Mar 10 1998 19.34 [Jari 2.32-2.33] -;; - [Anders] responds to mouse-3 handling problem: I have found the -;; cause of the problem, and I have a suggestion for a fix. -;; -;; The problem is caused by two things: -;; * The "mouse-save-then-kill" checks that the previous command also -;; was "mouse-save-then-kill". -;; -;; * The second (more severe) problem is that -;; "folding-mouse-context-sensitive" sets the point to the -;; location of the click, effectively making -;; "mouse-save-then-kill" mark the area between the point and the -;; point! (This is why no region appears.) -;; -;; The first problem can be easily fixed by setting "this-command" -;; in "folding-mouse-call-original": -;; -;; - Now the good old mouse-3 binding is back again. -;; - (folding-mouse-context-sensitive): Added `save-excursion' as -;; Anders suggested before setting `state'. -;; (folding-mouse-call-original): commented out experimental code and -;; used (setq this-command orig-func) as Anders suggested. -;; -;; Mar 10 1998 19.34 [Jari 2.31] -;; - (folding-act): Added `event' to `folding-behave-table' calls. -;; Input argument takes now `event' too -;; - (folding-mouse-context-sensitive): Added argument `event' -;; - (folding-mouse-call-original): Added (this-command orig-func) -;; when calling original command. -;; - (folding-bind-default-mouse): Changed mouse bindings. The -;; button-3 can't be mapped by folding, because folding is unable to -;; call the original function `mouse-save-then-kill'. Passing simple -;; element to `mouse-save-then-kill' won't do the job. Eg if I -;; (clicked mouse-1) moved mouse pointer to place X and pressed -;; mouse-3, the area was not highlighted in folding mode. If folding -;; mode was off the are was highlighted. I traced the -;; `folding-mouse-call-original' and it was passing exactly the same -;; event as without folding mode. I have no clue what to do about -;; it...That's why I removed default mouse-3 binding and left it to -;; emacs. This bug was reported by Ryszard Kubiak" -;; -;; -;; Feb 12 1998 19.34 [Jari 2.30] -;; - (html-mode): New mode added to `folding-mode-marks-alist' -;; - (folding-get-mode-marks): Rewritten, now return 3rd element too. -;; - (folding-comment-fold): Added note that function with `comment-end' -;; is not supported. Function will flag error in those cases. -;; - (folding-convert-to-major-folds): Conversion failed if eg; you -;; switched between modes that has 2 and 1 comments, like -;; /* */ (C) and //(C++). Now the conversion is bit smarter, but it's -;; impossible to convert from /* */ to // directly because we don't -;; know how to remove */ mark, you see: -;; -;; Original mode was C -;; -;; /* {{{ */ -;; -;; And now used changed it to C++ mode, and ran command -;; `folding-convert-to-major-folds'. We no longer have information -;; about old mode's beginning or end comment markers, so we only -;; can convert the folds to format -;; -;; // {{{ */ -;; -;; Where the ending comment mark from old mode is left there. -;; This is slightly imperfect situation, but at least the fold -;; conversion works. -;; -;; Jan 28 1998 19.34 [Jari 2.25-2.29] -;; - Added `generic-mode' to fold list, suggested by Wayne Adams -;; -;; - Finally rewrote the awesome menu-bar code: now uses standard -;; easy-menu Which works in both XEmacs and Emacs. The menu is no -;; longer under "Tools", but appear when minor mode is turned on. -;; - Radical changes: Decided to remove all old lucid and epoch -;; dependencies. Lot of code removed and reprogrammed. -;; - I also got rid of the `folding-has-minor-mode-map-alist-p' variable -;; and old 18.xx function `folding-merge-keymaps'. -;; - Symbol's value as variable is void ((folding-xemacs-p)) error fixed. -;; - Optimized 60 `folding-use-overlays-p' calls to only 4 within -;; `folding-subst-regions'. (Used elp.el). It seems that half of the -;; time is spent in the function `folding-narrow-to-region' -;; function. Could it be optimized somehow? -;; - Changed "lucid" tests to `folding-xemacs-p' variable tests. -;; - Removed `folding-hack' and print message 'Info, ignore missing -;; functions.." instead. It's better that we see the missing -;; functions and not define dummy hacks for them. -;; -;; Nov 13 1997 19.34 [Jari 2.18-2.24] -;; - Added tcl-mode fold marks, suggested by Petteri Kettunen -;; -;; - Removed some old code and modified the hook functions a bit. -;; - Added new user function `folding-convert-to-major-folds', key "%". -;; - Added missing items to Emacs menubar, didn't dare to touch the -;; XEmacs part. -;; - `folding-comment-fold': Small fix. commenting didn't work on -;; closed folds. or if point was on topmost fold. -;; - Added `folding-advice-instantiate' And corrected byte compiler -;; message: Warning: variable oldposn bound but not referenced -;; Warning: reference to free variable folding-stack -;; - updated (require 'custom) code -;; -;; Nov 6 1997 19.34 [Jari 2.17] -;; - Uwe Brauer used folding for Latex files -;; and he wished a feature that would allow him to comment away ext -;; that was inside fold; when compiling the TeX file. -;; - Added new user function `folding-comment-fold'. And new -;; keybinding ";". -;; -;; Oct 8 1997 19.34 [Jari 2.16] -;; - Now the minor mode map is always re-installed when this file is -;; loaded. If user accidentally made mistake in -;; `folding-default-keys-function', he can simply try again and -;; reload this file to have the new key definitions. -;; - Previously user had to manually go and delete the previous map -;; from the `minor-mode-map-alist' before he could try again. -;; -;; Sep 29 1997 19.34 [Jari 2.14-2.15] -;; - Robert Marshall Sent enhancement to goto-line -;; code. Now M-g works more intuitively. -;; - Reformatted totally the documentation so that it can be ripped to -;; html with jari's ema-doc.pls and t2html.pls Perl scripts. -;; - Run through checkdoc.el 1.55 and Elint 1.10 and corrected code. -;; - Added defcustom support. (not tested) -;; -;; Sep 19 1997 19.28 [Jari 2.13] -;; - Robert Marshall Sent small correction to -;; overlay code, where the 'owner tag was set wrong. -;; -;; Aug 14 1997 19.28 [Jari 2.12 ] -;; - A small regexp bug (extra whitespace was required after closing -;; fold) cause failing of folding-convert-buffer-for-printing in the -;; following situation -;; - Reported by Guide. Fixed now. -;; -;; {{{ Main topic -;; {{{ Subsection -;; }}} << no space or end tag here! -;; }}} Main topic -;; -;; Aug 14 1997 19.28 [Jari 2.11] -;; - Guide Van Hoecke reported that -;; he was using closing text for fold like: -;; -;; {{{ Main topic -;; {{{ Subsection -;; }}} Subsection -;; }}} Main topic -;; -;; And when he did folding-convert-buffer-for-printing, it couldn't -;; remove those closing marks but threw an error. I modified the -;; function so that the regexp accepts anything after closing fold. -;; -;; Apr 18 1997 19.28 [Jari 2.10] -;; - Corrected function folding-show-current-subtree, which didn't -;; find the correct end region, because folding-pick-move needed -;; point at the top of beginning fold. Bug was reported by Uwe -;; Brauer Also changed folding-mark-look-at, -;; which now has new call parameter 'move. -;; -;; Mar 22 1997 19.28 [Jari 2.9] -;; - Made the XEmacs20 match more stricter, so that -;; folding-emacs-version gets value 'XEmacs19. Also added note about -;; folding in WinNT in the compatibility section. -;; - Added sh-script-mode indented-text-mode folding marks. -;; - Moved the version from branch to the root, because the extra -;; overlay code added, seems to be behaving well and it didn't break -;; the existing functionality. -;; -;; Feb 17 1997 19.28 [Jari 2.8.1.2] -;; - Cleaned up Dan's changes. First: we must not replace the -;; selective display code, but offer these two choices: Added -;; folding-use-overlays-p function which looks variable -;; folding-allow-overlays. -;; - Dan uses function from another Emacs specific (19.34+?) package -;; hs-discard-overlays. This is not available in 19.28. it should -;; be replaced with some new function... I didn't do that yet. -;; - The overlays don't exist in XEmacs. XE19.15 has promises: at least -;; I have heard that they have overlay.el library to mimic Emacs -;; functions. -;; - Now the overlay support can be turned on by setting -;; folding-allow-overlays to non-nil. The default is to use selective -;; display. Overlay Code is not tested! -;; -;; Feb 17 1997 19.28 [Dan 2.8.1.1] -;; - Dan Nicolaescu sent patch that replaced -;; selective display code with overlays. -;; -;; Feb 10 1997 19.28 [jari 2.8] -;; - Ricardo Marek Kindly sent patch that -;; makes code XEmacs 20.0 compatible. Thank you. -;; -;; Nov 7 1996 19.28 [jari 2.7] -;; - When I was on picture-mode and turned on folding, and started -;; isearch (I don't remember how I got fold mode on exactly) it -;; gave error that the fold marks were not defined and emacs -;; locked up due to simultaneous isearch-loop -;; - Added few fixes to the isearch handling function to avoid -;; infinite error loops. -;; -;; Nov 6 1996 19.28 [jari 2.5 - 2.6] -;; - Situation: have folded buffer, manually _narrow_ somewhere, C-x n n -;; - Then try searching --> folding breaks. Now it checks if the -;; region is true narrow and not folding-narrow before trying -;; to go outside of region and open a fold -;; - If it's true narrow, then we stay in that narrowed region. -;; -;; folding-isearch-general :+ -;; folding-region-has-folding-marks-p :+ -;; -;; Oct 23 1996 19.28 [jari 2.4] -;; folding-display-name :+ new user cmd "C-n" -;; folding-find-folding-mark :+ new -;; folding-pick-move :! rewritten, full of bugs -;; folding-region-open-close :! rewritten, full of bugs -;; -;; Oct 22 1996 19.28 [jari 2.3] -;; - folding-pick-move :! rewritten -;; folding-region-open-close :+ new user cmd "#" -;; folding-show-current-subtree :+ new user cmd "C-s", hides too -;; -;; Aug 01 1996 19.31 [andersl] -;; - folding-subst-regions, variable `font-lock-mode' set to nil. -;; Thanks to -;; -;; Jun 19 1996 19.31 [andersl] -;; - The code has proven itself stable through the beta testing phase -;; which has lasted the past six months. -;; - A lot of comments written. -;; - The package `folding-isearch' integrated. -;; - Some code cleanup: -;; BOLP -> folding-BOL :! renamed -;; folding-behave-table :! field `down' removed. -;; -;; -;; Mar 14 1996 19.28 [jari 1.27] -;; - No code changes. Only some textual corrections/additions. -;; - Section "about keymaps" added. -;; -;; Mar 14 1996 19.28 [jackr 1.26] -;; - spell-check run over code. -;; -;; Mar 14 1996 19.28 [davidm 1.25] -;; - David Masterson This patch makes the menubar in -;; XEmacs work better. After I made this patch, the Hyperbole menus -;; starting working as expected again. I believe the use of -;; set-buffer-menubar has a problem, so the recommendation in XEmacs -;; 19.13 is to use set-menubar-dirty-flag. -;; -;; Mar 13 1996 19.28 [andersl 1.24] -;; - Corrected one minor bug in folding-check-if-folding-allowed -;; -;; Mar 12 1996 19.28 [jari 1.23] -;; - Renamed all -func variables to -function. -;; -;; mar 12 1996 19.28 [jari 1.22] -;; - Added new example how to change the fold marks. The automatic folding -;; was reported to cause unnecessary delays for big files (eg. when using -;; ediff) Now there is new function variable which can totally disable -;; automatic folding if the return value is nil. -;; -;; folding-check-allow-folding-function :+ new variable -;; folding-check-if-folding-allowed :+ new func -;; folding-mode-find-file :! modified -;; folding-mode-write-file :! better docs -;; folding-goto-line :! arg "n" --> "N" due to XEmacs 19.13 -;; -;; Mar 11 1996 19.28 [jari 1.21] -;; - Integrated changes made by Anders' to v1.19 [folding in beta dir] -;; -;; Jan 25 1996 19.28 [jari 1.20] -;; - ** Mainly cosmetic changes ** -;; - Added some 'Section' codes that can be used with lisp-mnt.el -;; - Deleted all code in 'special section' because it was never used. -;; - Moved some old "-v-" named variables to better names. -;; - Removed folding-mode-flag that was never used. -;; -;; Jan 25 1996 19.28 [jari 1.19] -;; - Put Anders' latest version into RCS tree. -;; -;; Jan 03 1996 19.30 [andersl] -;; - `folding-mouse-call-original' uses `call-interactively'. -;; `folding-mouse-context-sensitive' doesn't do `save-excursion'. -;; (More changes will come later.) -;; `folding-mouse-yank-at-p' macro corrected (quote added). -;; Error for `epoch::version' removed. -;; `folding-mark-look-at' Regexp change .* -> [^\n\r]* to avoid error. -;; -;; Nov 24 1995 19.28 [andersl] -;; - (sequencep ) added to the code which checks for the existence -;; of a tools menu. -;; -;; Aug 27 1995 19.28 19.12 [andersl] -;; - Keybindings restructured. They now conforms with the -;; new 19.29 styleguide. Old keybindings are still available. -;; - Menus new goes into the "Tools" menu, if present. -;; - `folding-mouse-open-close' renamed to -;; `folding-mouse-context-sensitive'. -;; - New entry `other' in `folding-behave-table' which defaults to -;; `folding-calling-original'. -;; - `folding-calling-original' now gets the event from `last-input-event' -;; if called without arguments (i.e. the way `folding-act' calls it.) -;; - XEmacs mouse support added. -;; - `folding-mouse-call-original' can call functions with or without -;; the Event argument. -;; - Byte compiler generates no errors neither for Emacs 19 and XEmacs. -;; -;; Aug 24 1995 19.28 [jari 1.17] -;; - To prevent infinite back calling loop, Anders suggested smart way -;; to detect that func call chain is started only once. -;; folding-calling-original :+ v, call chain terminator -;; "Internal" :! v, all private vars have this string -;; folding-mouse-call-original :! v, stricter chain check. -;; "copyright" :! t, newer notice -;; "commentary" :! t, ripped non-supported emacsen -;; -;; Aug 24 1995 19.28 [jari 1.16] -;; ** mouse interface rewritten -;; - Anders gave many valuable comments about simplifying the mouse usage, -;; he suggested that every mouse function should accept standard event, -;; and it should be called directly. -;; folding-global :- v, not needed -;; folding-mode-off-hook :- v, not needed -;; folding-mouse-action-table :- v, not needed any more -;; folding-default-keys-function :+ v, key settings -;; folding-default-mouse-keys-function:+ v, key settings -;; folding-mouse :- f, unnecessary -;; 'all mouse funcs' :! f, now accept "e" parameter -;; folding-default-keys :+ f, defines keys -;; folding-mouse-call-original :+ f, call orig mouse func -;; "examples" :! t, radical rewrote, only one left -;; -;; Aug 24 1995 19.28 [jari 1.15] -;; - some minor changes. If we're inside a fold, Mouse-3 will go one -;; level up if it points END or BEG marker. -;; folding-mouse-yank-at-point:! v, added 'up 'down -;; folding-mark-look-at :! f, more return values: '11 and 'end-in -;; folding-open-close :! f, bug, didn't exit if inside fold -;; PMIN, PMAX, NEXTP, add-l :+ more macros fom tinylibm.el -;; -;; Aug 23 1995 19.28 [andersl 1.14] -;; - Added `eval-when-compile' around 1.13 byte-compiler fix -;; to avoid code to be executed when using a byte-compiled version -;; of folding.el. -;; - Binds mode keys via `minor-mode-map-alist' -;; (i.e. `folding-merge-keymaps' is not used in modern Emacsen.) -;; This means that the user can not bind `folding-mode-map' to a new -;; keymap, \\(s\\|\\)he must modify the existing one. -;; - `defvars' for global feature test variables `folding-*-p'. -;; - `folding-mouse-open-close' now detects when the current fold was been -;; pressed. (The "current" is the fold around which the buffer is -;; narrowed.) -;; -;; Aug 23 1995 19.28 [jari 1.13] -;; - 19.28 Byte compile doesn't handle fboundp, boundp well. That's a bug. -;; Set some dummy functions to get cleaner output. -;; - The folding-mode-off doesn't seem very useful, because it -;; is never run when another major-mode is turned on ... maybe we should -;; utilize kill-all-local-variables-hooks with defadvice around -;; kill-all-local-variables ... -;; -;; folding-emacs-version :+ added. it was in the docs, but not defined -;; kill-all-local-variables-hooks :! v, moved to variable section -;; list-buffers-mode-alist :! v, --''-- -;; "compiler hacks" :+ section added -;; "special" :+ section added -;; "Compatibility" :! moved at the beginning -;; -;; Aug 22 1995 19.28 [jari 1.12] -;; - Only minor changes -;; BOLP, BOLPP, EOLP, EOLPP :+ f, macros added from tinylibm.el -;; folding-mouse-pick-move :! f, when cursor at beolp, move always up -;; "bindings" :+ added C-cv and C-cC-v -;; -;; Aug 22 1995 19.28 [jari 1.11] -;; - Inspired by mouse so much, that this revision contain substantial -;; changes and enhancements. Mouse is now powered! -;; - Anders wanted mouse to operate according to 'mouse cursor', not -;; current 'point'. -;; folding-mouse-yank-at-point: controls it. Phwew, I like this -;; one a lot. -;; -;; examples :! t, totally changed, now 2 choices -;; folding-mode-off-hook :+ v, when folding ends -;; folding-global :+ v, global store value -;; folding-mouse-action-table :! v, changed -;; folding-mouse :! f, stores event to global -;; folding-mouse-open-close :! f, renamed, mouse activated open -;; folding-mode :! f, added 'off' hook -;; folding-event-posn :+ f, handles FSF mouse event -;; folding-mouse-yank-at-p :+ f, check which mouse mode is on -;; folding-mouse-point :+ f, return working point -;; folding-mouse-move :+ f, mouse moving down , obsolete ?? -;; folding-mouse-pick-move :+ f, mouse move accord. fold mark -;; folding-next-visible-heading :+ f, from tinyfold.el -;; folding-previous-visible-heading :+ f, from tinyfold.el -;; folding-pick-move :+ f, from tinyfold.el -;; -;; -;; Aug 22 1995 19.28 [jari 1.10] -;; - Minor typing errors corrected : fol-open-close 'hide --> 'close -;; This caused error when trying to close open fold with mouse -;; when cursor was sitting on fold marker. -;; -;; Aug 22 1995 19.28 [jari 1.9] -;; - Having heard good suggestions from Anders...! -;; "install" : add-hook for folding missed -;; folding-open-close : generalized -;; folding-behave-table : NEW, logical behavior control -;; folding-:mouse-action-table : now folding-mouse-action-table -;; -;; - The mouse function seems to work with FSF emacs only, because -;; XEmacs doesn't know about double or triple clicks. We're working -;; on the problem... -;; -;; Aug 21 1995 19.28 [jari 1.8] -;; - Rearranged the file structure so that all variables are at the -;; beginning of file. With new functions, it easy to open-close -;; fold. Added word "code:" or "setup:" to the front of code folds, -;; so that the toplevel folds can be recognized more easily. -;; - Added example hook to install section for easy mouse use. -;; - Added new functions. -;; folding-get-mode-marks : return folding marks -;; folding-mark-look-at : status of current line, fold mark in it? -;; folding-mark-mouse : execute action on fold mark -;; -;; -;; Aug 17 1995 19.28/X19.12 [andersl 1.7] -;; - Failed when loaded into XEmacs, when `folding-mode-map' was -;; undefined. Folding marks for three new major modes added: -;; rexx-mode, erlang-mode and xerl-mode. -;; -;; Aug 14 1995 19.28 [jari 1.6] -;; - After I met Anders we exchanged some thoughts about usage philosophy -;; of error and signal commands. I was annoyed by the fact that they -;; couldn't be suppressed, when the error was "minor". Later Anders -;; developed fdb.el, which will be integrated to FSF 19.30. It -;; offers by-passing error/signal interference. -;; --> I changed back all the error commands that were taken away. -;; -;; Jun 02 1995 19.28 [andersl] -;; - "Narrow" not present in mode-line when in folding-mode. -;; -;; May 12 1995 19.28 [jari 1.5] -;; - Installation text cleaned: reference to 'install-it' removed, -;; because such function doesn't exist any more. The installation is -;; now automatic: it's done when user calls folding mode first time. -;; - Added 'private vars' section. made 'outside all folds' message -;; informational, not an error. -;; -;; May 12 1995 19.28 [jackr x.x] -;; - Corrected 'broken menu bar' problem. -;; - Even though make-sparse-keymap claims its argument (a string to -;; name the menu) is optional, it's not. Lucid has other -;; arrangements for the same thing.. -;; -;; May 10 1995 19.28 [jari 1.2] -;; - Moved provide to the end of file. -;; - Rearranged code so that the common functions are at the beginning. -;; Reprogrammed the whole installation with hooks. Added Write file -;; hook that makes sure you don't write in 'binary' while folding were -;; accidentally off. -;; - Added regexp text for certain files which are not allowed to -;; 'auto fold' when loaded. -;; - changed some 'error' commands to 'messages', this prevent screen -;; mixup when debug-on-error is set to t -;; + folding-list-delete , folding-msg , folding-mode-find-file , -;; folding-mode-write-file , folding-check-folded , folding-keep-hooked -;; -;; 1.7.4 May 04 1995 19.28 [jackr 1.11] -;; - Some compatibility changes: -;; v.18 doesn't allow an arg to make-sparse-keymap -;; testing epoch::version is trickier than that -;; free-variable reference cleanup -;; -;; 1.7.3 May 04 1995 19.28 [jari] -;; - Corrected folding-mode-find-file-hook , so that it has more -;; 'mode turn on' capabilities through user function -;; + folding-mode-write-file-hook: Makes sure your file is saved -;; properly, so that you don't end up saving in 'binary'. -;; + folding-check-folded: func, default checker provided -;; + folding-check-folded-file-function variable added, User can put his -;; 'detect folding.el file' methods here. -;; + folding-mode-install-it: func, Automatic installation with it -;; -;; 1.7.2 Apr 01 1995 19.28 [jackr] , Design support by [jari] -;; - Added folding to FSF & XEmacs menus -;; -;; 1.7.1 Apr 28 1995 19.28 [jackr] -;; - The folding editor's merge-keymap couldn't handle FSF menu-bar, -;; so some minor changes were made, previous is '>' and enhancements -;; are '>' -;; -;; < (buffer-disable-undo new-buffer) -;; --- -;; > (buffer-flush-undo new-buffer) -;; 1510,1512c1510 -;; < key (if (symbolp keycode) -;; < (vector keycode) -;; < (char-to-string keycode)) -;; --- -;; > key (char-to-string keycode) -;; 1802,1808d1799 -;; < ;;{{{ Compatibility hacks for various Emacs versions -;; < -;; < (or (fboundp 'buffer-disable-undo) -;; < (fset 'buffer-disable-undo (symbol-function 'buffer-flush-undo))) -;; < -;; < ;;}}} -;; -;; -;; X.x Dec 1 1994 19.28 [jari] -;; - Only minor change. Made the folding mode string user configurable. -;; Added these variables: -;; folding-mode-string, folding-inside-string,folding-inside-mode-name -;; - Changed revision number from 1.6.2 to 1.7 , so that people know -;; this package has changed. - -;;}}} - -;;; Code: - -;;{{{ setup: require packages - -;;; ......................................................... &require ... - -(eval-when-compile (require 'cl)) -(require 'easymenu) - -(defvar folding-package-url-location - "Latest folding is available at http://cvs.xemacs.org/viewcvs.cgi/XEmacs/packages/xemacs-packages/text-modes/") - -;;}}} -;;{{{ setup: byte compiler hacks - -;;; ............................................. &byte-compiler-hacks ... -;;; - This really only should be evaluated in case we're about to byte -;;; compile this file. Since `eval-when-compile' is evaluated when -;;; the uncompiled version is used (great!) we test if the -;;; byte-compiler is loaded. - -;; Make sure `advice' is loaded when compiling the code. - -(eval-and-compile - (require 'advice) - (defvar folding-xemacs-p (or (boundp 'xemacs-logo) - (featurep 'xemacs)) - "Folding determines which emacs version it is running. t if Xemacs.") - ;; loading overlay.el package removes some byte compiler whinings. - ;; By default folding does not use overlay code. - (if folding-xemacs-p - (or (fboundp 'overlay-start) ;; Already loaded - (load "overlay" 'noerr) ;; No? Try loading it. - (message "\ -** folding.el: XEmacs 19.15+ has package overlay.el, try to get it. - This is only warning. Folding does not use overlays by - default. You can safely ignore possible overlay byte - compilation error - messages.")))) - -(eval-when-compile - - (when nil ;; Disabled 2000-01-05 - ;; While byte compiling - (if (string= (buffer-name) " *Compiler Input*") - (progn - (message "** folding.el:\ - Info, Ignore [X]Emacs's missing motion/event/posn functions calls")))) - - ;; ARGS: (symbol variable-p library) - (defadvice find-function-search-for-symbol (around folding act) - "Set folding flag for `find-file-noselect' to open all folds." - (let ((file (ad-get-arg 2))) - (when file - (message "FILE %s" file) - (put 'find-file-noselect 'folding file))) - ad-do-it - (put 'find-file-noselect 'folding nil)) - - (defun folding-find-file-noselect () - (let* ((file (get 'find-file-noselect 'folding)) - (buffer (and file - ;; It may be absolute path name, file.el, - ;; or just "file". - (or (find-buffer-visiting file) - (get-buffer file) - (get-buffer (concat file ".el")))))) - (when buffer - (with-current-buffer buffer - (when (symbol-value 'folding-mode) ;; Byte compiler silencer - (turn-off-folding-mode)))))) - - ;; See find.func.el find-function-search-for-symbol - ;; Make C-h f and mouse-click work to jump to a file. Folding mode - ;; Must be turned off due to regexps in find.func.el that can't - ;; search ^M lines. - - (defadvice find-file-noselect (after folding act) - "When called by `find-function-search-for-symbol', turn folding off." - (folding-find-file-noselect)) - - (defadvice make-sparse-keymap - (before - make-sparse-keymap-with-optional-argument - (&optional byte-compiler-happyfier) - activate) - "This advice does nothing except adding an optional argument -to keep the byte compiler happy when compiling Emacs specific code -with XEmacs.") - - ;; XEmacs and Emacs 19 differs when it comes to obsolete functions. - ;; We're using the Emacs 19 versions, and this simply makes the - ;; byte-compiler stop wining. (Why isn't there a warning flag which - ;; could have turned off?) - - (and (boundp 'mode-line-format) - (put 'mode-line-format 'byte-obsolete-variable nil)) - - (and (fboundp 'byte-code-function-p) - (put 'byte-code-function-p 'byte-compile nil)) - - (and (fboundp 'eval-current-buffer) - (put 'eval-current-buffer 'byte-compile nil))) - -(defsubst folding-preserve-active-region () - "In XEmacs keep the region alive. In Emacs do nothing." - (if (boundp 'zmacs-region-stays) ;Keep regions alive - (set 'zmacs-region-stays t))) ;use `set' to Quiet Emacs Byte Compiler - -;; Work around the NT Emacs Cut'n paste bug in selective-display which -;; doesn't preserve C-m's. Only installed in problematic Emacs and -;; in other cases these lines are no-op. - -(eval-and-compile - (when (and (not folding-xemacs-p) - (memq (symbol-value 'window-system) '(win32 w32)) ; NT Emacs - (string< emacs-version "20.4")) ;at least in 19.34 .. 20.3.1 - - (unless (fboundp 'char-equal) - (defalias 'char-equal 'equal)) - - (unless (fboundp 'subst-char) - (defun subst-char (str char to-char) - "Replace in STR every CHAR with TO-CHAR." - (let ((len (length str)) - (ret (copy-sequence str))) ;because 'aset' is destructive - (while (> len 0) - (if (char-equal (aref str (1- len)) char) - (aset ret (1- len) to-char)) - (decf len)) - ret))) - - (defadvice kill-new (around folding-win32-fix-selective-display act) - "In selective display, convert each C-m to C-a. See `current-kill'." - (let* ((string (ad-get-arg 0))) - (when (and selective-display (string-match "\C-m" (or string ""))) - (setq string (subst-char string ?\C-m ?\C-a))) - ad-do-it)) - - (defadvice current-kill (around folding-win32-fix-selective-display act) - "In selective display, convert each C-a back to C-m. See `kill-new'." - ad-do-it - (let* ((string ad-return-value)) - (when (and selective-display (string-match "\C-a" (or string ""))) - (setq string (subst-char string ?\C-a ?\C-m)) - (setq ad-return-value string)))))) - -(defvar folding-mode) ;; Byte Compiler silencer - -(when (locate-library "mode-motion") ;; XEmacs - (defun folding-mode-motion-highlight-fold (event) - "Highlight line under mouse if it has a foldmark." - (when folding-mode - (funcall - ;; Emacs Byte Compiler Shutup fix - (symbol-function 'mode-motion-highlight-internal) - event - (function - (lambda () - (beginning-of-line) - (if (folding-mark-look-at) - (search-forward-regexp "^[ \t]*")))) - (function - (lambda () - (if (folding-mark-look-at) - (end-of-line))))))) - (require 'mode-motion) - (add-hook 'mode-motion-hook 'folding-mode-motion-highlight-fold 'at-end)) - -;;}}} - -;;{{{ setup: some variable - -;;; .................................................. &some-variables ... - -;; This is a list of structures which keep track of folds being entered -;; and exited. It is a list of (MARKER . MARKER) pairs, followed by the -;; symbol `folded'. The first of these represents the fold containing -;; the current one. If the view is currently outside all folds, this -;; variable has value nil. - -(defvar folding-stack nil - "Internal. A list of marker pairs representing folds entered so far.") - -(defvar folding-version (substring "$Revision: 3.42 $" 11 15) - "Version number of folding.el.") - -;;}}} -;;{{{ setup: bind - -;;; .......................................................... &v-bind ... - -;; Custom hack for Emacs that does not have custom - -(eval-and-compile - (condition-case () - (require 'custom) - (error nil)) - (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) - nil ;; We've got what we needed - ;; We have the old custom-library, hack around it! - (defmacro defgroup (&rest args) - nil) - (defmacro defcustom (var value doc &rest args) - (` (defvar (, var) (, value) (, doc)))))) - -(defgroup folding nil - "Managing buffers with Folds." - :group 'tools) - -(defcustom folding-mode-prefix-key "\C-c@" - "*Prefix key to use for Folding commands in Folding mode." - :type 'string - :group 'folding) - -(defcustom folding-goto-key "\M-g" - "*Key to be bound to `folding-goto-line' in folding mode. -The default value is M - g, but you probably don't want folding to -occupy it if you have used M - g got `goto-line'." - :type 'string - :group 'folding) - -(defcustom folding-font-lock-begin-mark 'font-lock-reference-face - "Face to highlight beginning fold mark." - :type 'face - :group 'folding) - -(defcustom folding-font-lock-end-mark 'font-lock-reference-face - "Face to highlight end fold mark." - :type 'face - :group 'folding) - -(defvar folding-mode-map nil - "Keymap used in Folding mode (a minor mode).") - -(defvar folding-mode-prefix-map nil - "Keymap used in Folding mode keys sans `folding-mode-prefix-key'.") - -;;;###autoload -(defvar folding-mode nil - "When Non nil, Folding mode is active in the current buffer.") - -(make-variable-buffer-local 'folding-mode) -(set-default 'folding-mode nil) - -(defmacro folding-kbd (key function) - "Folding: define KEY with FUNCTION to `folding-mode-prefix-map'. -This is used when assigning keybindings to `folding-mode-map'. -See also `folding-mode-prefix-key'." - (` (define-key - folding-mode-prefix-map - (, key) (, function)))) - -(defun folding-bind-default-mouse () - "Bind default mouse keys used by Folding mode." - (interactive) - (cond - (folding-xemacs-p - (define-key folding-mode-map [(button3)] - 'folding-mouse-context-sensitive) - ;; (define-key folding-mode-map '(double button3) 'folding-hide-current-entry) - (define-key folding-mode-map [(control shift button2)] - 'folding-mouse-pick-move)) - (t - (define-key folding-mode-map [mouse-3] 'folding-mouse-context-sensitive) - (define-key folding-mode-map [C-S-mouse-2] 'folding-mouse-pick-move)))) - -(defun folding-bind-terminal-keys () - "In non-window system, rebind C - f and C - b as folding-{forward,backward}-char." - (unless (or (and (boundp 'window-system) ;; Emacs - (symbol-value 'window-system)) ;; Byte compiler silencer - (and (fboundp 'console-type) ;; XEmacs - (let ((val (fboundp 'console-type))) - (not (eq 'tty val))))) - (define-key folding-mode-map "\C-f" 'folding-forward-char) - (define-key folding-mode-map "\C-b" 'folding-backward-char))) - -(defun folding-bind-default-keys () - "Bind the default keys used the `folding-mode'. - -The variable `folding-mode-prefix-key' contains the prefix keys, -the default is C - c @. - -For the good ol' key bindings, please use the function -`folding-bind-backward-compatible-keys' instead." - (interactive) - (define-key folding-mode-map folding-goto-key 'folding-goto-line) - (folding-bind-terminal-keys) - (define-key folding-mode-map "\C-e" 'folding-end-of-line) - (folding-kbd "\C-f" 'folding-fold-region) - (folding-kbd ">" 'folding-shift-in) - (folding-kbd "<" 'folding-shift-out) - (folding-kbd "\C-t" 'folding-show-all) - (folding-kbd "\C-s" 'folding-show-current-entry) - (folding-kbd "\C-x" 'folding-hide-current-entry) - (folding-kbd "\C-o" 'folding-open-buffer) - (folding-kbd "\C-w" 'folding-whole-buffer) - (folding-kbd "\C-r" 'folding-convert-buffer-for-printing) - (folding-kbd "\C-k" 'folding-marks-kill) - (folding-kbd "\C-v" 'folding-pick-move) - (folding-kbd "v" 'folding-previous-visible-heading) - (folding-kbd " " 'folding-next-visible-heading) - (folding-kbd "." 'folding-context-next-action) - ;; C-u: kinda "up" -- "down" - (folding-kbd "\C-u" 'folding-toggle-enter-exit) - (folding-kbd "\C-q" 'folding-toggle-show-hide) - ;; Think "#" as a 'fence' - (folding-kbd "#" 'folding-region-open-close) - ;; Esc-; is the standard emacs commend add key. - (folding-kbd ";" 'folding-comment-fold) - (folding-kbd "%" 'folding-convert-to-major-folds) - (folding-kbd "/" 'folding-all-comment-blocks-in-region) - (folding-kbd "\C-y" 'folding-show-current-subtree) - (folding-kbd "\C-z" 'folding-hide-current-subtree) - (folding-kbd "\C-n" 'folding-display-name) - - (folding-kbd "I" 'folding-insert-advertise-folding-mode)) - -(defun folding-bind-backward-compatible-keys () - "Bind keys traditionally used by Folding mode. -For bindings which follow newer Emacs minor mode conventions, please -use the function `folding-bind-default-keys'. - -This function sets `folding-mode-prefix-key' to `C-c'." - (interactive) - (setq folding-mode-prefix-key "\C-c") - (folding-bind-default-keys)) - -(defun folding-bind-outline-compatible-keys () - "Bind keys used by the minor mode `folding-mode'. -The keys used are as much as possible compatible with -bindings used by Outline mode. - -Currently, some outline mode functions doesn't have a corresponding -folding function. - -The variable `folding-mode-prefix-key' contains the prefix keys, -the default is C - c @. - -For the good ol' key bindings, please use the function -`folding-bind-backward-compatible-keys' instead." - (interactive) - ;; Traditional keys: - (folding-bind-terminal-keys) - (define-key folding-mode-map "\C-e" 'folding-end-of-line) - ;; Mimic Emacs 20.3 allout.el bindings - (folding-kbd ">" 'folding-shift-in) - (folding-kbd "<" 'folding-shift-out) - (folding-kbd "\C-n" 'folding-next-visible-heading) - (folding-kbd "\C-p" 'folding-previous-visible-heading) - ;; ("\C-u" outline-up-current-level) - ;; ("\C-f" outline-forward-current-level) - ;; ("\C-b" outline-backward-current-level) - ;; (folding-kbd "\C-i" 'folding-show-current-subtree) - (folding-kbd "\C-s" 'folding-show-current-subtree) - (folding-kbd "\C-h" 'folding-hide-current-subtree) - (folding-kbd "\C-k" 'folding-marks-kill) - (folding-kbd "!" 'folding-show-all) - (folding-kbd "\C-d" 'folding-hide-current-entry) - (folding-kbd "\C-o" 'folding-show-current-entry) - ;; (" " outline-open-sibtopic) - ;; ("." outline-open-subtopic) - ;; ("," outline-open-supertopic) - ;; Other bindings not in allout.el - (folding-kbd "\C-a" 'folding-open-buffer) - (folding-kbd "\C-q" 'folding-whole-buffer) - (folding-kbd "\C-r" 'folding-convert-buffer-for-printing) - (folding-kbd "\C-w" 'folding-fold-region) - (folding-kbd "I" 'folding-insert-advertise-folding-mode)) - -;;{{{ goto-line (advice) - -(defcustom folding-advice-instantiate t - "*In non-nil install advice code. Eg for `goto-line'." - :type 'boolean - :group 'folding) - -(defcustom folding-shift-in-on-goto t - "*Flag in folding adviced function `goto-line'. -If non-nil, folds are entered when going to a given line. -Otherwise the buffer is unfolded. Can also be set to 'show. -This variable is used only if `folding-advice-instantiate' was -non-nil when folding was loaded. - -See also `folding-goto-key'." - :type 'boolean - :group 'folding) - -(when folding-advice-instantiate - (eval-when-compile (require 'advice)) - ;; By Robert Marshall - (defadvice goto-line (around folding-goto-line first activate) - "Go to line ARG, entering folds if `folding-shift-in-on-goto' is t. -It attempts to keep the buffer in the same visibility state as before." - (let () ;; (oldposn (point)) - ad-do-it - (if (and folding-mode - (or (folding-point-folded-p (point)) - (<= (point) (point-min-marker)) - (>= (point) (point-max-marker)))) - (let ((line (ad-get-arg 0))) - (if folding-shift-in-on-goto - (progn - (folding-show-all) - (goto-char 1) - (and (< 1 line) - (not (folding-use-overlays-p)) - (re-search-forward "[\n\C-m]" nil 0 (1- line))) - (let ((goal (point))) - (while (prog2 (beginning-of-line) - (if (eq folding-shift-in-on-goto 'show) - (progn - (folding-show-current-entry t t) - (folding-point-folded-p goal)) - (folding-shift-in t)) - (goto-char goal))) - (folding-narrow-to-region - (and folding-narrow-by-default (point-min)) - (point-max) t))) - (if (or folding-stack (folding-point-folded-p (point))) - (folding-open-buffer)))))))) - -;;}}} - -(defun folding-bind-foldout-compatible-keys () - "Bind keys for `folding-mode' compatible with Foldout mode. - -The variable `folding-mode-prefix-key' contains the prefix keys, -the default is C - c @." - (interactive) - (folding-kbd "\C-z" 'folding-shift-in) - (folding-kbd "\C-x" 'folding-shift-out)) - -;;; This function is here, just in case we ever would like to add -;;; `hideif' support to folding mode. Currently, it is only used to -;;; which keys shouldn't be used. - -;;(defun folding-bind-hideif-compatible-keys () -;; "Bind keys for `folding-mode' compatible with Hideif mode. -;; -;;The variable `folding-mode-prefix-key' contains the prefix keys, -;;the default is C-c@." -;; (interactive) -;; ;; Keys defined by `hideif' -;; ;; (folding-kbd "d" 'hide-ifdef-define) -;; ;; (folding-kbd "u" 'hide-ifdef-undef) -;; ;; (folding-kbd "D" 'hide-ifdef-set-define-alist) -;; ;; (folding-kbd "U" 'hide-ifdef-use-define-alist) -;; -;; ;; (folding-kbd "h") 'hide-ifdefs) -;; ;; (folding-kbd "s") 'show-ifdefs) -;; ;; (folding-kbd "\C-d") 'hide-ifdef-block) -;; ;; (folding-kbd "\C-s") 'show-ifdef-block) -;; -;; ;; (folding-kbd "\C-q" 'hide-ifdef-toggle-read-only) -;; ) - -;;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. . - -;; Not used for modern Emacsen. -(defvar folding-saved-local-keymap nil - "Keymap used to save non-folding keymap. -(so it can be restored when folding mode is turned off.)") - -;;;###autoload -(defcustom folding-default-keys-function 'folding-bind-default-keys - "*Function or list of functions used to define keys for Folding mode. -Possible values are: - folding-bind-default-key - The standard keymap. - - `folding-bind-backward-compatible-keys' - Keys used by older versions of Folding mode. This function - does not conform to Emacs 19.29 style conversions concerning - key bindings. The prefix key is C - c - - `folding-bind-outline-compatible-keys' - Define keys compatible with Outline mode. - - `folding-bind-foldout-compatible-keys' - Define some extra keys compatible with Foldout. - -All except `folding-bind-backward-compatible-keys' used the value of -the variable `folding-mode-prefix-key' as prefix the key. -The default is C - c @" - :type 'function - :group 'folding) - -;; Not yet implemented: -;; folding-bind-hideif-compatible-keys -;; Define some extra keys compatible with hideif. - -;;;###autoload -(defcustom folding-default-mouse-keys-function 'folding-bind-default-mouse - "*Function to bind default mouse keys to `folding-mode-map'." - :type 'function - :group 'folding) - -(defvar folding-mode-menu nil - "Keymap containing the menu for Folding mode.") - -(defvar folding-mode-menu-name "Fld" ;; Short menu name - "Name of pull down menu.") - -;;}}} -;;{{{ setup: hooks - -;;; ......................................................... &v-hooks ... - -(defcustom folding-mode-hook nil - "*Hook called when Folding mode is entered. - -A hook named `-folding-hook' is also called, if it -exists. Eg., `c-mode-folding-hook' is called whenever Folding mode is -started in C mode." - :type 'hook - :group 'folding) - -(defcustom folding-load-hook nil - "*Hook run when file is loaded." - :type 'hook - :group 'folding) - -;;}}} -;;{{{ setup: user config - -;;; ........................................................ &v-Config ... - -(defvar folding-narrow-by-default t - "If t (default) things like isearch will enter folds. If nil the -folds will be opened, but not entered.") - -;; Q: should this inherit mouse-yank-at-point's value? maybe not. -(defvar folding-mouse-yank-at-point t - "If non-nil, mouse activities are done at point instead of 'mouse cursor'. -Behaves like `mouse-yank-at-point'.") - -(defcustom folding-folding-on-startup t - "*If non-nil, buffers are folded when starting Folding mode." - :type 'boolean - :group 'folding) - -(defcustom folding-internal-margins 1 - "*Number of blank lines left next to fold mark when tidying folds. - -This variable is local to each buffer. To set the default value for all -buffers, use `set-default'. - -When exiting a fold, and at other times, `folding-tidy-inside' is invoked -to ensure that the fold is in the correct form before leaving it. This -variable specifies the number of blank lines to leave between the -enclosing fold marks and the enclosed text. - -If this value is nil or negative, no blank lines are added or removed -inside the fold marks. A value of 0 (zero) is valid, meaning leave no -blank lines. - -See also `folding-tidy-inside'." - :type 'boolean - :group 'folding) - -(make-variable-buffer-local 'folding-internal-margins) - -(defvar folding-mode-string " Fld" - "Buffer-local variable that hold the fold depth description.") - -(set-default 'folding-mode-string " Fld") - -;; Sets `folding-mode-string' appropriately. This allows the Folding mode -;; description in the mode line to reflect the current fold depth. - -(defconst folding-inside-string " " ; was ' inside ', - "Mode line addition to show 'inside' levels of fold.") - -;;;###autoload -(defcustom folding-inside-mode-name "Fld" - "*Mode line addition to show inside levels of 'fold' ." - :type 'string - :group 'folding) - -(defcustom folding-check-folded-file-function - 'folding-check-folded - "*Function that return t or nil after examining if the file is folded." - :type 'function - :group 'folding) - -(defcustom folding-check-allow-folding-function - 'folding-check-if-folding-allowed - "*Function that return t or nil after deciding if automatic folding." - :type 'function - :group 'folding) - -;;;###autoload -(defcustom folding-mode-string "Fld" - "*The minor mode string displayed when mode is on." - :type 'string - :group 'folding) - -;;;###autoload -(defcustom folding-mode-hook-no-regexp "RMAIL" - "*Regexp which disable automatic folding mode turn on for certain files." - :type 'string - :group 'folding) - -;;; ... ... ... ... ... ... ... ... ... ... ... ... ... .... &v-tables ... - -(defcustom folding-behave-table - '((close folding-hide-current-entry) - (open folding-show-current-entry) ; Could also be `folding-shift-in'. - (up folding-shift-out) - (other folding-mouse-call-original)) - "*Table of of logical commands and their associated functions. -If you want fold to behave like `folding-shift-in', when it 'open' -a fold, you just change the function entry in this table. - -Table form: - '( (LOGICAL-ACTION CMD) (..) ..)" - :type '(repeat - (symbol :tag "logical action") - (function :tag "callback")) - :group 'folding) - -;;; ... ... ... ... ... ... ... ... ... ... ... ... ... ..... &v-marks ... - -;;;###autoload -(defvar folding-mode-marks-alist nil - "List of (major-mode . fold mark) default combinations to use. -When Folding mode is started, the major mode is checked, and if there -are fold marks for that major mode stored in `folding-mode-marks-alist', -those marks are used by default. If none are found, the default values -of \"{{{ \" and \"}}}\" are used. - -Use function `folding-add-to-marks-list' to add more fold marks. The function -also explains the alist use in details. - -Use function `folding-set-local-variables' if you change the current mode's -folding marks during the session.") - -;;}}} -;;{{{ setup: private - -;;; ....................................................... &v-private ... - -(defvar folding-narrow-placeholder nil - "Internal. Mark where \"%n\" used to be in `mode-line-format'. -Must be nil.") - -(defvar folding-bottom-mark nil - "Internal marker of the true bottom of a fold.") - -(defvar folding-bottom-regexp nil - "Internal. Regexp marking the bottom of a fold.") - -(defvar folding-regexp nil - "Internal. Regexp for hunting down the `folding-top-mark' even in comments.") - -(defvar folding-secondary-top-mark nil - "Internal. Additional stuff that can be inserted as part of a top marker.") - -(defvar folding-top-mark nil - "Internal. The actual string marking the top of a fold.") - -(defvar folding-top-regexp nil - "Internal. -Regexp describing the string beginning a fold, possible with -leading comment thingies and like that.") - -(defvar folded-file nil - "Enter folding mode when this file is loaded. -(buffer local, use from a local variables list).") - -(defvar folding-calling-original nil - "Internal. Non-nil when original mouse binding is executed.") - -(defvar folding-narrow-overlays nil - "Internal. Keep the list of overlays.") -(make-variable-buffer-local 'folding-narrow-overlays) - -(defcustom folding-allow-overlays nil - "*If non-nil use overlay code. If nil, then selective display is used. -Note, that this code is highly experimental and will not most likely do what -you expect. using value t will not change folding to use overlays -completely. This variable was introduced to experiment with the overlay -interface, but the work never finished and it is unlikely that it -will continued any later time. Folding at present state is designed -too highly for selective display to make the change worthwhile." - :type 'boolean - :group 'folding) - -;;}}} -;;{{{ Folding install - -(defun folding-easy-menu-define () - "Define folding easy menu." - (interactive) - (easy-menu-define - folding-mode-menu - (if folding-xemacs-p - nil - (list folding-mode-map)) - "Folding menu" - (list - folding-mode-menu-name - ["Enter Fold" folding-shift-in t] - ["Exit Fold" folding-shift-out t] - ["Show Fold" folding-show-current-entry t] - ["Hide Fold" folding-hide-current-entry t] - "----" - ["Show Whole Buffer" folding-open-buffer t] - ["Fold Whole Buffer" folding-whole-buffer t] - ["Show subtree" folding-show-current-subtree t] - ["Hide subtree" folding-hide-current-subtree t] - ["Display fold name" folding-display-name t] - "----" - ["Move previous" folding-previous-visible-heading t] - ["Move next" folding-next-visible-heading t] - ["Pick fold" folding-pick-move t] - ["Next action (context)" folding-context-next-action t] - "----" - ["Foldify region" folding-fold-region t] - ["Open or close folds in region" folding-region-open-close t] - ["Open folds to top level" folding-show-all t] - "----" - ["Comment text in fold" folding-comment-fold t] - ["Convert for printing(temp buffer)" - folding-convert-buffer-for-printing t] - ["Convert to major-mode folds" folding-convert-to-major-folds t] - ["Move comments inside folds in region" - folding-all-comment-blocks-in-region t] - ["Delete fold marks in this fold" folding-marks-kill t] - ["Insert folding URL reference" - folding-insert-advertise-folding-mode t] - "----" - ["Toggle enter and exit mode" folding-toggle-enter-exit t] - ["Toggle show and hide" folding-toggle-show-hide t] - "----" - ["Folding mode off" folding-mode t]))) - -(defun folding-install-keymaps () - "Install keymaps." - (unless folding-mode-map - (setq folding-mode-map (make-sparse-keymap))) - (unless folding-mode-prefix-map - (setq folding-mode-prefix-map (make-sparse-keymap))) - (if (listp folding-default-keys-function) - (mapcar 'funcall folding-default-keys-function) - (funcall folding-default-keys-function)) - (funcall folding-default-mouse-keys-function) - (folding-easy-menu-define) - (define-key folding-mode-map - folding-mode-prefix-key folding-mode-prefix-map) - ;; Install the keymap into `minor-mode-map-alist'. The keymap will - ;; be activated as soon as the variable `folding-mode' is set to - ;; non-nil. - (let ((elt (assq 'folding-mode minor-mode-map-alist))) - ;; Always remove old map before adding new definitions. - (if elt - (setq minor-mode-map-alist - (delete elt minor-mode-map-alist))) - (push (cons 'folding-mode folding-mode-map) minor-mode-map-alist)) - ;; Update minor-mode-alist - (or (assq 'folding-mode minor-mode-alist) - (push '(folding-mode folding-mode-string) minor-mode-alist)) - ;; Needed for XEmacs - (or (fboundp 'buffer-disable-undo) - (fset 'buffer-disable-undo (symbol-function 'buffer-flush-undo)))) - -(defun folding-uninstall-keymaps () - "Uninstall keymaps." - (let ((elt (assq 'folding-mode minor-mode-map-alist))) - (if elt - (setq minor-mode-map-alist - (delete elt minor-mode-map-alist))) - (if (setq elt (assq 'folding-mode minor-mode-alist)) - (setq minor-mode-alist - (delete elt minor-mode-alist))) - (folding-uninstall-hooks))) - -(defun folding-install (&optional uninstall) - "Install or UNINSTALL folding." - (interactive "P") - (cond - (uninstall - (folding-uninstall-keymaps) - (folding-uninstall-hooks)) - (t - (folding-install-keymaps)))) - -(defun folding-uninstall () - "Uninstall folding." - (interactive) - (folding-install 'uninstall) - ;; Unwrap all buffers. - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (goto-char (point-min)) - (when (or folding-mode - ;; To be sure, check this at the same time - ;; Somebody may have just done - ;; (setq folding-mode nil), which is bad thing. - ;; Setting variable won't restore the buffer. - (re-search-forward "{{{" nil t)) - (turn-off-folding-mode))))) - -;;}}} -;;{{{ code: misc - -(defsubst folding-get-mode-marks (&optional mode) - "Return fold markers for MODE. default is for current `major-mode'. - -Return: - \(beg-marker end-marker\)" - (interactive) - (let* (elt) - (unless (setq elt (assq (or mode major-mode) - folding-mode-marks-alist)) - (error "Folding error: mode is not in `folding-mode-marks-alist'")) - (list (nth 1 elt) (nth 2 elt) (nth 3 elt)))) - -(defun folding-region-has-folding-marks-p (beg end) - "Check is there is fold mark in region BEG END." - (save-excursion - (goto-char beg) - (when (memq (folding-mark-look-at) '(1 11)) - (goto-char end) - (memq (folding-mark-look-at) '(end end-in))))) - -;;; - Thumb rule: because "{{{" if more meaningful, all returns values -;;; are of type integerp if it is found. -;;; -(defun folding-mark-look-at (&optional mode) - "Check status of current line. Does it contain a fold mark?. - -MODE - - 'move move over fold mark - -Return: - - 0 1 numberp, line has fold begin mark - 0 = closed, 1 = open, - 11 = open, we're inside fold, and this is top marker - - 'end end mark - - 'end-in end mark, inside fold, floor marker - - nil no fold marks .." - (let* (case-fold-search - (marks (folding-get-mode-marks)) - (stack folding-stack) - (bm (regexp-quote (nth 0 marks))) ;begin mark - (em (concat "^[ \t\n]*" (regexp-quote (nth 1 marks)))) - (bm-re (concat - (concat "^[ \t\n]*" bm) - (if (and nil - (string= - " " (substring (nth 0 marks) - (length (nth 1 marks))))) - ;; Like "}}} *" - "*" - ""))) - ret - point) - (save-excursion - (beginning-of-line) - (cond - ((looking-at bm-re) - (setq point (point)) - (cond - ((looking-at (concat "^[ \t\n]*" bm "[^\r\n]*\r")) ;; closed - (setq ret 0)) - (t ;; open fold marker - (goto-char (point-min)) - (cond - ((and stack ;; we're inside fold - ;; allow spaces - (looking-at (concat "[ \t\n]*" bm))) - (setq ret 11)) - (t - (setq ret 1)))))) - ((looking-at em) - (setq point (point)) - ;; - The stack is a list if we've entered inside fold. There - ;; is no text after fold END mark - ;; - At bol ".*\n[^\n]*" doesn't work but "\n[^\n]*" at eol does?? - (cond - ((progn - (end-of-line) - (or (and stack (eobp)) ;normal ending - (and stack ;empty newlines only, no text ? - (not (looking-at "\n[^ \t\n]*"))))) - (setq ret 'end-in)) - (t ;all rest are newlines - (setq ret 'end)))))) - (cond - ((and mode point) - (goto-char point) - ;; This call breaks if there is no marks on the point, - ;; because there is no parameter 'nil t' in call. - ;; --> there is error in this function if that happens. - (beginning-of-line) - (re-search-forward (concat bm "\\|" em)) - (backward-char 1))) - ret)) - -(defsubst folding-mark-look-at-top-mark-p () - "Check if line contain folding top marker." - (integerp (folding-mark-look-at))) - -(defsubst folding-mark-look-at-bottom-mark-p () - "Check if line contain folding bottom marker." - (symbolp (folding-mark-look-at))) - -(defun folding-act (action &optional event) - "Execute logical ACTION based on EVENT. - -References: - `folding-behave-table'" - (let* ((elt (assoc action folding-behave-table))) - (if elt - (funcall (nth 1 elt) event) - (error "Folding mode (folding-act): Unknown action %s" action)))) - -(defun folding-region-open-close (beg end &optional close) - "Open all folds inside region BEG END. Close if optional CLOSE is non-nil." - (interactive "r\nP") - (let* ((func (if (null close) - 'folding-show-current-entry - 'folding-hide-current-entry)) - tmp) - (save-excursion - ;; make sure the beg is first. - (if (> beg end) ;swap order - (setq tmp beg beg end end tmp)) - (goto-char beg) - (while (and - ;; the folding-show-current-entry/hide will move point - ;; to beg-of-line So we must move to the end of - ;; line to continue search. - (if (and close - (eq 0 (folding-mark-look-at))) ;already closed ? - t - (funcall func) - (end-of-line) - t) - (folding-next-visible-heading) - (< (point) end)))))) - -(defun fold-marks-kill () - "If over fold, open fold and kill beginning and end fold marker. -Return t ot nil if marks were removed." - (interactive) - (if (not (folding-mark-look-at)) - (when (interactive-p) - (message "Folding: Cursor not over fold. Can't removed fold marks.") - nil) - (multiple-value-bind (beg end) - (folding-show-current-entry) - (let* ((kill-whole-line t)) - ;; must be done in this order, because point moves after kill. - (goto-char end) - (beginning-of-line) - (kill-line) - (goto-char beg) - (beginning-of-line) - (kill-line) - ;; Return status - t)))) - -(defun folding-hide-current-subtree () - "Call `folding-show-current-subtree' with argument 'hide." - (interactive) - (folding-show-current-subtree 'hide)) - -(defun folding-show-current-subtree (&optional hide) - "Show or HIDE all folds inside current fold. -Point must be over beginning fold mark." - (interactive "P") - (let* ((stat (folding-mark-look-at 'move)) - (beg (point)) - end) - (cond - ((memq stat '(0 1 11)) ;It's BEG fold - (when (eq 0 stat) ;it was closed - (folding-show-current-entry) - (goto-char beg)) ;folding-pick-move needs point at fold - (save-excursion - (if (folding-pick-move) - (setq end (point)))) - (if (and beg end) - (folding-region-open-close beg end hide))) - (t - (if (interactive-p) - (message "point is not at fold beginning.")))))) - -(defun folding-display-name () - "Show current active fold name." - (interactive) - (let* ((pos (folding-find-folding-mark)) - name) - (when pos - (save-excursion - (goto-char pos) - (if (looking-at ".*[{]+") ;Drop "{" mark away. - (setq pos (match-end 0))) - (setq name (buffer-substring - pos - (progn - (end-of-line) - (point)))))) - (if name - (message (format "fold:%s" name))))) - -;;}}} -;;{{{ code: events - -(defun folding-event-posn (act event) - "According to ACT read mouse EVENT struct and return data from it. -Event must be simple click, no dragging. - -ACT - 'mouse-point return the 'mouse cursor' point - 'window return window pointer - 'col-row return list (col row)" - (cond - ((not folding-xemacs-p) - ;; short Description of FSF mouse event - ;; - ;; EVENT : (mouse-3 (# 128 (20 . 104) -23723628)) - ;; event-start : (# 128 (20 . 104) -23723628)) - ;; ^^^MP - ;; mp = mouse point - (let* ((el (funcall (symbol-function 'event-start) event))) - (cond - ((eq act 'mouse-point) - (nth 1 el)) ;is there macro for this ? - ((eq act 'window) - (funcall (symbol-function 'posn-window) el)) - ((eq act 'col-row) - (funcall (symbol-function 'posn-col-row) el)) - (t - (error "Unknown request" act))))) - - (folding-xemacs-p - (cond - ((eq act 'mouse-point) - (funcall (symbol-function 'event-point) event)) - ((eq act 'window) - (funcall (symbol-function 'event-window) event)) - ;; Must be tested! (However, it's not used...) - ((eq act 'col-row) - (list (funcall (symbol-function 'event-x) event) - (funcall (symbol-function 'event-y) event))) - (t - (error "Unknown request" act)))) - (t - (error "This version of Emacs can't handle events.")))) - -(defmacro folding-interactive-spec-p () - "Preserve region during `interactive'. -In XEmacs user could also set `zmacs-region-stays'." - (if folding-xemacs-p - ;; preserve selected region - `'(interactive "_p") - `'(interactive "p"))) - -(defmacro folding-mouse-yank-at-p () - "Check if user use \"yank at mouse point\" feature. - -Please see the variable `folding-mouse-yank-at-point'." - 'folding-mouse-yank-at-point) - -(defun folding-mouse-point (&optional event) - "Return mouse's working point. Optional EVENT is mouse click. -When used on XEmacs, return nil if no character was under the mouse." - (if (or (folding-mouse-yank-at-p) - (null event)) - (point) - (folding-event-posn 'mouse-point event))) - -;;}}} - -;;{{{ code: hook - -(defun folding-is-hooked () - "Check if folding hooks are installed." - (and (memq 'folding-mode-write-file write-file-hooks) - (memq 'folding-mode-find-file find-file-hooks))) - -;;;###autoload -(defun folding-uninstall-hooks () - "Remove hooks set by folding." - (turn-off-folding-mode) - (remove-hook 'finder-mode-hook 'folding-mode) - (remove-hook 'write-file-hooks 'folding-mode-write-file) - (remove-hook 'find-file-hooks 'folding-mode-find-file)) - -;;;###autoload -(defun folding-install-hooks () - "Install folding hooks." - (folding-mode-add-find-file-hook) - (add-hook 'finder-mode-hook 'folding-mode) - (or (memq 'folding-mode-write-file write-file-hooks) - (add-hook 'write-file-hooks 'folding-mode-write-file 'end))) - -;;;###autoload -(defun folding-keep-hooked () - "Make sure hooks are in their places." - (unless (folding-is-hooked) - (folding-uninstall-hooks) - (folding-install-hooks))) - -;;}}} -;;{{{ code: Mouse handling - -(defun folding-mouse-call-original (&optional event) - "Execute original mouse function using mouse EVENT. - -Do nothing if original function does not exist. - -Does nothing when called by a function which has earlier been called -by us. - -Sets global: - `folding-calling-original'" - (interactive "@e") ;; Was "e" - ;; Without the following test we could easily end up in a endless - ;; loop in case we would call a function which would call us. - ;; - ;; (An easy constructed example is to bind the function - ;; `folding-mouse-context-sensitive' to the same mouse button both in - ;; `folding-mode-map' and in the global map.) - (if folding-calling-original - nil - ;; `folding-calling-original' is global - (setq folding-calling-original t) - (unwind-protect - (progn - (or event - (setq event last-input-event)) - (let (mouse-key) - (cond - ((not folding-xemacs-p) - (setq mouse-key (make-vector 1 (car-safe event)))) - (folding-xemacs-p - (setq mouse-key - (vector - (append - (event-modifiers event) - (list (intern - (format "button%d" - (funcall - (symbol-function 'event-button) - event)))))))) - (t - (error "This version of Emacs can't handle events."))) - ;; Test string: http://www.csd.uu.se/~andersl - ;; andersl A T csd uu se - ;; (I have `ark-goto-url' bound to the same key as - ;; this function.) - ;; - ;; turn off folding, so that we can see the real - ;; function behind it. - ;; - ;; We have to restore the current buffer, otherwise the - ;; let* won't be able to restore the old value of - ;; folding-mode. In my environment, I have bound a - ;; function which starts mail when I click on an e-mail - ;; address. When returning, the current buffer has - ;; changed. - (let* ((folding-mode nil) - (orig-buf (current-buffer)) - (orig-func (key-binding mouse-key))) - ;; call only if exist - (when orig-func - ;; Check if the original function has arguments. If - ;; it does, call it with the event as argument. - (unwind-protect - (progn - (setq this-command orig-func) - (call-interactively orig-func)) -;;; #untested, but included here for further reference -;;; (cond -;;; ((not (string-match "mouse" (symbol-name orig-func))) -;;; (call-interactively orig-func)) -;;; ((string-match "^mouse" (symbol-name orig-func)) -;;; (funcall orig-func event)) -;;; (t -;;; ;; Some other package's mouse command, -;;; ;; should we do something special here for -;;; ;; somebody? -;;; (funcall orig-func event))) - (set-buffer orig-buf)))))) - ;; This is always executed, even if the above generates an error. - (setq folding-calling-original nil)))) - -(defun folding-mouse-context-sensitive (event) - "Perform some operation depending on the context of the mouse pointer. -EVENT is mouse event. - -The variable `folding-behave-table' contains a mapping between contexts and -operations to perform. - -The following contexts can be handled (They are named after the -natural operation to perform on them): - - open - A folded fold. - close - An open fold, which isn't the one current topmost one. - up - The topmost visible fold. - other - Anything else. - -Note that the `pointer' can be either the buffer point, or the mouse -pointer depending in the setting of the user option -`folding-mouse-yank-at-point'." - (interactive "e") - (let* ( ;; - Get mouse cursor point, or point - (point (folding-mouse-point event)) - state) - (if (null point) - ;; The user didn't click on any text. - (folding-act 'other event) - (save-excursion - (goto-char point) - (setq state (folding-mark-look-at))) - (cond - ((eq state 0) - (folding-act 'open event)) - ((eq state 1) - (folding-act 'close event)) - ((eq state 11) - (folding-act 'up event)) - ((eq 'end state) - (folding-act 'close)) - ((eq state 'end-in) - (folding-act 'up event)) - (t - (folding-act 'other event)))))) - -;;; FIXME: #not used, the pick move handles this too -(defun folding-mouse-move (event) - "Move down if sitting on fold mark using mouse EVENT. - -Original function behind the mouse is called if no FOLD action wasn't -taken." - (interactive "e") - (let* ( ;; - Get mouse cursor point, or point - (point (folding-mouse-point event)) - state) - (save-excursion - (goto-char point) - (beginning-of-line) - (setq state (folding-mark-look-at))) - (cond - ((not (null state)) - (goto-char point) - (folding-next-visible-heading) t) - (t - (folding-mouse-call-original event))))) - -(defun folding-mouse-pick-move (event) - "Pick movement if sitting on beg/end fold mark using mouse EVENT. -If mouse if at the `beginning-of-line' point, then always move up. - -Original function behind the mouse is called if no FOLD action wasn't -taken." - (interactive "e") - (let* ( ;; - Get mouse cursor point, or point - (point (folding-mouse-point event)) - state) - (save-excursion - (goto-char point) - (setq state (folding-mark-look-at))) - (cond - ((not (null state)) - (goto-char point) - (if (= point - (save-excursion (beginning-of-line) (point))) - (folding-previous-visible-heading) - (folding-pick-move))) - (t - (folding-mouse-call-original event))))) - -;;}}} -;;{{{ code: engine - -(defun folding-set-mode-line () - "Update modeline with fold level." - (if (null folding-stack) - (kill-local-variable 'folding-mode-string) - (make-local-variable 'folding-mode-string) - (setq folding-mode-string - (if (eq 'folded (car folding-stack)) - (concat - folding-inside-string "1" folding-inside-mode-name) - (concat - folding-inside-string - (int-to-string (length folding-stack)) - folding-inside-mode-name))))) - -(defun folding-clear-stack () - "Clear the fold stack, and release all the markers it refers to." - (let ((stack folding-stack)) - (setq folding-stack nil) - (while (and stack (not (eq 'folded (car stack)))) - (set-marker (car (car stack)) nil) - (set-marker (cdr (car stack)) nil) - (setq stack (cdr stack))))) - -(defun folding-check-if-folding-allowed () - "Return non-nil when buffer allowed to be folded automatically. -When buffer is loaded it may not be desirable to fold it immediately, -because the file may be too large, or it may contain fold marks, that -really are not _real_ folds. (Eg. RMAIL saved files may have the -marks) - -This function returns t, if it's okay to proceed checking the fold status -of file. Returning nil means that folding should not touch this file. - -The variable `folding-check-allow-folding-function' normally contains this -function. Change the variable to use your own scheme." - - (or (let ((file (get 'find-file-noselect 'folding))) - ;; When a file reference is "pushed" is a C-h v buffer that says: - ;; test is a Lisp function in `~/foo/tmp/test.el' A flag gets set - ;; (see adviced code) and we must not fold this buffer, because - ;; it will be immediately searched. - (and file - (not (string-match (regexp-quote file) - (or buffer-file-name ""))))) - ;; Do not fold these files - (null (string-match folding-mode-hook-no-regexp (buffer-name))))) - -(defun folding-mode-find-file () - "One of the funcs called whenever a `find-file' is successful. -It checks to see if `folded-file' has been set as a buffer-local -variable, and automatically starts Folding mode if it has. - -This allows folded files to be automatically folded when opened. - -To make this hook effective, the symbol `folding-mode-find-file-hook' -should be placed at the end of `find-file-hooks'. If you have -some other hook in the list, for example a hook to automatically -uncompress or decrypt a buffer, it should go earlier on in the list. - -See also `folding-mode-add-find-file-hook'." - (let* ((check-fold folding-check-folded-file-function) - (allow-fold folding-check-allow-folding-function)) - ;; Turn mode on only if it's allowed - (if (funcall allow-fold) - (or (and (and check-fold (funcall check-fold)) - (folding-mode 1)) - (and (assq 'folded-file (buffer-local-variables)) - folded-file - (folding-mode 1) - (kill-local-variable 'folded-file))) - ;; In all other cases, unfold buffer. - (if folding-mode - (folding-mode -1))))) - -;;;###autoload -(defun folding-mode-add-find-file-hook () - "Append `folding-mode-find-file-hook' to the list `find-file-hooks'. - -This has the effect that afterwards, when a folded file is visited, if -appropriate Emacs local variable entries are recognized at the end of -the file, Folding mode is started automatically. - -If `inhibit-local-variables' is non-nil, this will not happen regardless -of the setting of `find-file-hooks'. - -To declare a file to be folded, put `folded-file: t' in the file's -local variables. eg., at the end of a C source file, put: - -/* -Local variables: -folded-file: t -*/ - -The local variables can be inside a fold." - (interactive) - (or (memq 'folding-mode-find-file find-file-hooks) - (add-hook 'find-file-hooks 'folding-mode-find-file 'end))) - -(defun folding-mode-write-file () - "Folded files must be controlled by folding before saving. -This function turns on the folding mode if it is not activated. -It prevents 'binary pollution' upon save." - (let* ((check-func folding-check-folded-file-function) - (no-re folding-mode-hook-no-regexp) - (bn (or (buffer-name) ""))) - (if (and (not (string-match no-re bn)) - (boundp 'folding-mode) - (null folding-mode) - (and check-func (funcall check-func))) - (progn - ;; When folding mode is turned on it also 'folds' whole - ;; buffer... can't avoid that, since it's more important - ;; to save safely - (folding-mode 1))) - ;; hook returns nil, good habit - nil)) - -(defun folding-check-folded () - "Function to determine if this file is in folded form." - (let* ( ;; Could use folding-top-regexp , folding-bottom-regexp , - ;; folding-regexp But they are not available at load time. - (folding-re1 "^.?.?.?{{{") - (folding-re2 "[\r\n].*}}}")) - (save-excursion - (goto-char (point-min)) - ;; If we found both, we assume file is folded - (and (re-search-forward folding-re1 nil t) - ;; if file is folded, there are \r's - (search-forward "\r" nil t) - (re-search-forward folding-re2 nil t))))) - -;;}}} - -;;{{{ code: Folding mode - -(defun folding-font-lock-keywords (&optional mode) - "Return folding font-lock keywords for MODE." - ;; Add support mode-by-mode basis. Check if mode is already - ;; handled from the property list. - (multiple-value-bind (beg end) - (folding-get-mode-marks (or mode major-mode)) - (setq beg (concat "^[ \t]*" (regexp-quote beg) "[^\r\n]+")) - (setq end (concat "^[ \t]*" (regexp-quote end))) - (list - ;; the `t' says to overwrite any previous highlight. - ;; => Needed because folding marks are in comments. - (list beg 0 folding-font-lock-begin-mark t) - (list end 0 folding-font-lock-end-mark t)))) - -(defun folding-font-lock-support-instantiate (&optional mode) - "Add fold marks with `font-lock-add-keywords'." - (or mode - (setq mode major-mode)) - ;; Hide function from Byte Compiler. - (let* ((function 'font-lock-add-keywords)) - (when (fboundp function) - (funcall function - mode - (folding-font-lock-keywords mode)) - ;; In order to see new keywords font lock must be restarted. - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (when (and (eq major-mode mode) - (or font-lock-mode - ;; Hide variable from byte compiler. - (let ((sym 'global-font-lock-mode)) - (and (boundp sym) - (symbol-value sym))))) - ;; #todo: should we use font-lock-fontify-buffer instead? - (font-lock-mode -1) - (font-lock-mode 1))))))) - -(defun folding-font-lock-support () - "Add font lock support." - (let* ((list (get 'folding-mode 'font-lock))) - (unless (memq major-mode list) - ;; Support added, update known list - (push major-mode list) - (put 'folding-mode 'font-lock list) - (folding-font-lock-support-instantiate major-mode)))) - -(defun folding-set-local-variables () - "Set local fold mark variables. -If you're going to change the beginning and end mark in -`folding-mode-marks-alist'; you must call this function." - (set (make-local-variable 'folding-stack) nil) - (make-local-variable 'folding-top-mark) - (make-local-variable 'folding-secondary-top-mark) - (make-local-variable 'folding-top-regexp) - (make-local-variable 'folding-bottom-mark) - (make-local-variable 'folding-bottom-regexp) - (make-local-variable 'folding-regexp) - (or (and (boundp 'folding-top-regexp) - folding-top-regexp - (boundp 'folding-bottom-regexp) - folding-bottom-regexp) - (let ((folding-marks (assq major-mode - folding-mode-marks-alist))) - (if folding-marks - (setq folding-marks (cdr folding-marks)) - (setq folding-marks '("{{{" "}}}"))) - (apply 'folding-set-marks folding-marks)))) - -;;;###autoload -(defun turn-off-folding-mode () - "Turn off folding." - (folding-mode -1)) - -;;;###autoload -(defun turn-on-folding-mode () - "Turn on folding." - (folding-mode 1)) - -;;;###autoload -(defun folding-mode (&optional arg inter) - "A folding-editor-like minor mode. ARG INTER. - -These are the basic commands that Folding mode provides: - -\\{folding-mode-map} - -Keys starting with `folding-mode-prefix-key' - -\\{folding-mode-prefix-map} - - folding-convert-buffer-for-printing: - `\\[folding-convert-buffer-for-printing]' - Makes a ready-to-print, formatted, unfolded copy in another buffer. - - Read the documentation for the above functions for more information. - -Overview - - Folds are a way of hierarchically organizing the text in a file, so - that the text can be viewed and edited at different levels. It is - similar to Outline mode in that parts of the text can be hidden from - view. A fold is a region of text, surrounded by special \"fold marks\", - which act like brackets, grouping the text. Fold mark pairs can be - nested, and they can have titles. When a fold is folded, the text is - hidden from view, except for the first line, which acts like a title - for the fold. - - Folding mode is a minor mode, designed to cooperate with many other - major modes, so that many types of text can be folded while they are - being edited (eg., plain text, program source code, Texinfo, etc.). - -Folding-mode function - - If Folding mode is not called interactively (`(interactive-p)' is nil), - and it is called with two or less arguments, all of which are nil, then - the point will not be altered if `folding-folding-on-startup' is set - and `folding-whole-buffer' is called. This is generally not a good - thing, as it can leave the point inside a hidden region of a fold, but - it is required if the local variables set \"mode: folding\" when the - file is first read (see `hack-local-variables'). - - Not that you should ever want to, but to call Folding mode from a - program with the default behavior (toggling the mode), call it with - something like `(folding-mode nil t)'. - -Fold marks - - For most types of folded file, lines representing folds have \"{{{\" - near the beginning. To enter a fold, move the point to the folded line - and type `\\[folding-shift-in]'. You should no longer be able to see - the rest of the file, just the contents of the fold, which you couldn't - see before. You can use `\\[folding-shift-out]' to leave a fold, and - you can enter and exit folds to move around the structure of the file. - - All of the text is present in a folded file all of the time. It is just - hidden. Folded text shows up as a line (the top fold mark) with \"...\" - at the end. If you are in a fold, the mode line displays \"inside n - folds Narrow\", and because the buffer is narrowed you can't see outside - of the current fold's text. - - By arranging sections of a large file in folds, and maybe subsections - in sub-folds, you can move around a file quickly and easily, and only - have to scroll through a couple of pages at a time. If you pick the - titles for the folds carefully, they can be a useful form of - documentation, and make moving though the file a lot easier. In - general, searching through a folded file for a particular item is much - easier than without folds. - -Managing folds - - To make a new fold, set the mark at one end of the text you want in the - new fold, and move the point to the other end. Then type - `\\[folding-fold-region]'. The text you selected will be made into a - fold, and the fold will be entered. If you just want a new, empty fold, - set the mark where you want the fold, and then create a new fold there - without moving the point. Don't worry if the point is in the middle of - a line of text, `folding-fold-region' will not break text in the middle - of a line. After making a fold, the fold is entered and the point is - positioned ready to enter a title for the fold. Do not delete the fold - marks, which are usually something like \"{{{\" and \"}}}\". There may - also be a bit of fold mark which goes after the fold title. - - If the fold markers get messed up, or you just want to see the whole - unfolded file, use `\\[folding-open-buffer]' to unfolded the whole - file, so you can see all the text and all the marks. This is useful for - checking/correcting unbalanced fold markers, and for searching for - things. Use `\\[folding-whole-file]' to fold the buffer again. - - `folding-shift-out' will attempt to tidy the current fold just before - exiting it. It will remove any extra blank lines at the top and bottom, - \(outside the fold marks). It will then ensure that fold marks exists, - and if they are not, will add them (after asking). Finally, the number - of blank lines between the fold marks and the contents of the fold is - set to 1 (by default). - -Folding package customizations - - If the fold marks are not set on entry to Folding mode, they are set to - a default for current major mode, as defined by - `folding-mode-marks-alist' or to \"{{{ \" and \"}}}\" if none are - specified. - - To bind different commands to keys in Folding mode, set the bindings in - the keymap `folding-mode-map'. - - The hooks `folding-mode-hook' and `-folding-hook' are - called before folding the buffer and applying the key bindings in - `folding-mode-map'. This is a good hook to set extra or different key - bindings in `folding-mode-map'. Note that key bindings in - `folding-mode-map' are only examined just after calling these hooks; - new bindings in those maps only take effect when Folding mode is being - started. The hook `folding-load-hook' is called when Folding mode is - loaded into Emacs. - -Mouse behavior - - If you want folding to detect point of actual mouse click, please see - variable `folding-mouse-yank-at-p'. - - To customise the mouse actions, look at `folding-behave-table'." - (interactive) - - (let ((new-folding-mode - (if (not arg) - (not folding-mode) - (> (prefix-numeric-value arg) 0)))) - (or (eq new-folding-mode - folding-mode) - (if folding-mode - (progn - ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ progn ^^^ - ;; turn off folding - (if (null (folding-use-overlays-p)) - (setq selective-display nil)) - (folding-clear-stack) - (folding-narrow-to-region nil nil) - (folding-subst-regions (list 1 (point-max)) ?\r ?\n) - - ;; Restore "%n" (Narrow) in the mode line - (setq mode-line-format - (mapcar - (function - (lambda (item) - (if (equal item 'folding-narrow-placeholder) - "%n" item))) - mode-line-format))) - ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ else ^^^ - (cond - ((folding-use-overlays-p) - ;; This may be Emacs specific; how about XEmacs? - ;; - ;; make line-move-ignore-invisible buffer local, matches - ;; outline.el, and the 21 pre-release gets upset if this is - ;; defined globally in shell buffer... - (make-local-variable 'line-move-ignore-invisible) - (setq line-move-ignore-invisible t - buffer-invisibility-spec '((t . t)))) - (t - (setq selective-display t) - (setq selective-display-ellipses t))) - (unless (assq 'folding-mode minor-mode-alist) - ;; User has not run folding-install or he did call - ;; folding-uninstall which completely wiped package out. - ;; => anyway now he calls us, so be there for him - (folding-install)) - (folding-keep-hooked) ;set hooks if not there - (widen) - (setq folding-narrow-overlays nil) - (folding-set-local-variables) - (folding-font-lock-support) - (unwind-protect - (let ((hook-symbol (intern-soft - (concat - (symbol-name major-mode) - "-folding-hook")))) - (run-hooks 'folding-mode-hook) - (and hook-symbol - (run-hooks hook-symbol))) - (folding-set-mode-line)) - (and folding-folding-on-startup - (if (or (interactive-p) - arg - inter) - (folding-whole-buffer) - (save-excursion - (folding-whole-buffer)))) - (folding-narrow-to-region nil nil t) - ;; Remove "%n" (Narrow) from the mode line - (setq mode-line-format - (mapcar - (function - (lambda (item) - (if (equal item "%n") - 'folding-narrow-placeholder item))) - mode-line-format)))) - (setq folding-mode new-folding-mode) - (if folding-mode - (easy-menu-add folding-mode-menu) - (easy-menu-remove folding-mode-menu)))) - -;;}}} -;;{{{ code: setting fold marks - -;; You think those "\\(\\)" pairs are peculiar? Me too. Emacs regexp -;; stuff has a bug; sometimes "\\(.*\\)" fails when ".*" succeeds, but -;; only in a folded file! Strange bug! Must check it out sometime. - -(defun folding-set-marks (top bottom &optional secondary) - "Set the folding top and bottom mark for the current buffer. - -Input: - - TOP The topmost fold mark. Comment start + fold begin string. - BOTTOM The bottom fold mark Comment end + fold end string. - SECONDARY Usually the comment end indicator for the mode. This - is inserted by `folding-fold-region' after the fold top mark, - and is presumed to be put after the title of the fold. - -Example: - - html-mode: - - top: \"\" - sec: \" -->\" - -Notice that the top marker needs to be closed with SECONDARY comment end string. - -Various regular expressions are set with this function, so don't set the -mark variables directly." - (set (make-local-variable 'folding-top-mark) - top) - (set (make-local-variable 'folding-bottom-mark) - bottom) - (set (make-local-variable 'folding-secondary-top-mark) - secondary) - (set (make-local-variable 'folding-top-regexp) - (concat "\\(^\\|\r+\\)[ \t]*" - (regexp-quote folding-top-mark))) - (set (make-local-variable 'folding-bottom-regexp) - (concat "\\(^\\|\r+\\)[ \t]*" - (regexp-quote folding-bottom-mark))) - (set (make-local-variable 'folding-regexp) - (concat "\\(^\\|\r\\)\\([ \t]*\\)\\(\\(" - (regexp-quote folding-top-mark) - "\\)\\|\\(" - (regexp-quote folding-bottom-mark) - "[ \t]*\\(\\)\\($\\|\r\\)\\)\\)"))) - -;;}}} -;;{{{ code: movement - -(defun folding-next-visible-heading (&optional direction) - "Move up/down fold headers. -Backward if DIRECTION is non-nil returns nil if not moved = no next marker." - (interactive) - (let* ((begin-mark (nth 0 (folding-get-mode-marks))) - case-fold-search) - (if direction - (re-search-backward (concat "^" (regexp-quote begin-mark)) nil t) - (re-search-forward (concat "^" (regexp-quote begin-mark)) nil t)))) - -(defun folding-previous-visible-heading () - "Move upward fold headers." - (interactive) - (beginning-of-line) - (folding-next-visible-heading 'backward)) - -(defun folding-find-folding-mark (&optional end-fold) - "Search backward to find beginning fold. Skips subfolds. -Optionally searches forward to find END-FOLD mark. - -Return: - - nil - point position of fold mark" - (let* (case-fold-search - (elt (folding-get-mode-marks)) - (bm (regexp-quote (nth 0 elt))) ; markers defined for mode - (em (regexp-quote (nth 1 elt))) ; markers defined for mode - (re (concat "^" bm "\\|^" em)) - (count 0) - stat - moved) - (save-excursion - (cond - (end-fold - (folding-end-of-line) - ;; We must skip over inner folds - (while (and (null moved) - (re-search-forward re nil t)) - (setq stat (folding-mark-look-at)) - (cond - ((symbolp stat) - (setq count (1- count)) - (if (< count 0) ;0 or less means no middle folds - (setq moved t))) - ((memq stat '(1 11)) ;BEG fold - (setq count (1+ count))))) ;; end while - (when moved - (forward-char -3) - (setq moved (point)))) - (t - (while (and (null moved) - (re-search-backward re nil t)) - (setq stat (folding-mark-look-at)) - (cond - ((memq stat '(1 11)) - (setq count (1- count)) - (if (< count 0) ;0 or less means no middle folds - (setq moved (point)))) - ((symbolp stat) - (setq count (1+ count))))) - (when moved ;What's the result - (forward-char 3) - (setq moved (point)))))) - moved)) - -(defun folding-pick-move () - "Pick the logical movement on fold mark. -If at the end of fold, then move to the beginning and vice versa. - -If placed over closed fold moves to the next fold. When no next -folds are visible, stops moving. - -Return: - t if moved" - (interactive) - (let* (case-fold-search - (elt (folding-get-mode-marks)) - (bm (nth 0 elt)) ; markers defined for mode - (stat (folding-mark-look-at)) - moved) - (cond - ((eq 0 stat) ;closed fold - (when (re-search-forward (concat "^" (regexp-quote bm)) nil t) - (setq moved t) - (forward-char 3))) - ((symbolp stat) ;End fold - (setq moved (folding-find-folding-mark))) - ((integerp stat) ;Beg fold - (setq moved (folding-find-folding-mark 'end-fold)))) - (if (integerp moved) - (goto-char moved)) - moved)) - -;;; Idea by Scott Evans -(defun folding-context-next-action () - "Take next action according to point and context. -If point is at: - - Begin Fold : toggle open - close - End Fold : close - inside : fold current level." - (interactive) - (let ((state (folding-mark-look-at))) - (cond - ((eq state 0) - (folding-act 'open)) - ((eq state 1) - (folding-act 'close)) - ((eq state 11) - (folding-act 'up)) - ((eq 'end state) - (folding-act 'close)) - ((eq state 'end-in) - (folding-act 'up)) - (t - (folding-act 'other))))) - -(defun folding-forward-char-1 (&optional arg) - "See `folding-forward-char-1' for ARG." - (if (eq arg 1) - ;; Do it a faster way for arg = 1. - (if (eq (following-char) ?\r) - (let ((saved (point)) - (inhibit-quit t)) - (end-of-line) - (if (not (eobp)) - (forward-char) - (goto-char saved) - (error "End of buffer"))) - ;; `forward-char' here will do its own error if (eobp). - (forward-char)) - (if (> 0 (or arg (setq arg 1))) - (folding-backward-char (- arg)) - (let (goal saved) - (while (< 0 arg) - (skip-chars-forward "^\r" (setq goal (+ (point) arg))) - (if (eq goal (point)) - (setq arg 0) - (if (eobp) - (error "End of buffer") - (setq arg (- goal 1 (point)) - saved (point)) - (let ((inhibit-quit t)) - (end-of-line) - (if (not (eobp)) - (forward-char) - (goto-char saved) - (error "End of buffer")))))))))) - -(defmacro folding-forward-char-macro () - `(defun folding-forward-char (&optional arg) - "Move point right ARG characters, skipping hidden folded regions. -Moves left if ARG is negative. On reaching end of buffer, stop and -signal error." - ,(folding-interactive-spec-p) - ;; (folding-preserve-active-region) - (folding-forward-char-1 arg))) - -(folding-forward-char-macro) - -(defun folding-backward-char-1 (&optional arg) - "See `folding-backward-char-1' for ARG." - (if (eq arg 1) - ;; Do it a faster way for arg = 1. - ;; Catch the case where we are in a hidden region, and bump into a \r. - (if (or (eq (preceding-char) ?\n) - (eq (preceding-char) ?\r)) - (let ((pos (1- (point))) - (inhibit-quit t)) - (forward-char -1) - (beginning-of-line) - (skip-chars-forward "^\r" pos)) - (forward-char -1)) - (if (> 0 (or arg (setq arg 1))) - (folding-forward-char (- arg)) - (let (goal) - (while (< 0 arg) - (skip-chars-backward "^\r\n" (max (point-min) - (setq goal (- (point) arg)))) - (if (eq goal (point)) - (setq arg 0) - (if (bobp) - (error "Beginning of buffer") - (setq arg (- (point) 1 goal) - goal (point)) - (let ((inhibit-quit t)) - (forward-char -1) - (beginning-of-line) - (skip-chars-forward "^\r" goal))))))))) - -(defmacro folding-backward-char-macro () - `(defun folding-backward-char (&optional arg) - "Move point right ARG characters, skipping hidden folded regions. -Moves left if ARG is negative. On reaching end of buffer, stop and -signal error." - ,(folding-interactive-spec-p) - ;; (folding-preserve-active-region) - (folding-backward-char-1 arg))) - -(folding-backward-char-macro) - -(defmacro folding-end-of-line-macro () - `(defun folding-end-of-line (&optional arg) - "Move point to end of current line, but before hidden folded region. -ARG is line count. - -Has the same behavior as `end-of-line', except that if the current line -ends with some hidden folded text (represented by an ellipsis), the -point is positioned just before it. This prevents the point from being -placed inside the folded text, which is not normally useful." - ,(folding-interactive-spec-p) - ;;(interactive "p") - ;; (folding-preserve-active-region) - (if (or (eq arg 1) - (not arg)) - (beginning-of-line) - ;; `forward-line' also moves point to beginning of line. - (forward-line (1- arg))) - (skip-chars-forward "^\r\n"))) - -(folding-end-of-line-macro) - -(defun folding-skip-ellipsis-backward () - "Move the point backwards out of folded text. - -If the point is inside a folded region, the cursor is displayed at the -end of the ellipsis representing the folded part. This function checks -to see if this is the case, and if so, moves the point backwards until -it is just outside the hidden region, and just before the ellipsis. - -Returns t if the point was moved, nil otherwise." - (interactive) - (let ((pos (point)) - result) - (save-excursion - (beginning-of-line) - (skip-chars-forward "^\r" pos) - (or (eq pos (point)) - (setq pos (point) - result t))) - (goto-char pos) - result)) - -;;}}} - -;;{{{ code: Moving in and out of folds - -;;{{{ folding-shift-in - -(defun folding-shift-in (&optional noerror) - "Open and enter the fold at or around the point. - -Enters the fold that the point is inside, wherever the point is inside -the fold, provided it is a valid fold with balanced top and bottom -marks. Returns nil if the fold entered contains no sub-folds, t -otherwise. If an optional argument NOERROR is non-nil, returns nil if -there are no folds to enter, instead of causing an error. - -If the point is inside a folded, hidden region (as represented by an -ellipsis), the position of the point in the buffer is preserved, and as -many folds as necessary are entered to make the surrounding text -visible. This is useful after some commands eg., search commands." - (interactive) - (labels - ((open-fold nil - (let ((data (folding-show-current-entry noerror t))) - (and data - (progn - (when folding-narrow-by-default - (setq folding-stack - (if folding-stack - (cons (cons (point-min-marker) (point-max-marker)) - folding-stack) - '(folded))) - (folding-set-mode-line)) - (folding-narrow-to-region (car data) (nth 1 data))))))) - (let ((goal (point))) - (while (folding-skip-ellipsis-backward) - (beginning-of-line) - (open-fold) - (goto-char goal)) - (when (not folding-narrow-by-default) - (widen))))) - -;;}}} -;;{{{ folding-shift-out - -(defun folding-shift-out (&optional event) - "Exits the current fold with EVENT." - (interactive) - (if folding-stack - (progn - (folding-tidy-inside) - (cond - ((folding-use-overlays-p) - (folding-subst-regions - (list (overlay-end (car folding-narrow-overlays)) - (overlay-start (cdr folding-narrow-overlays))) ?\n ?\r) - ;; So point is correct in other windows. - (goto-char (overlay-end (car folding-narrow-overlays)))) - (t - (folding-subst-regions (list (point-min) (point-max)) ?\n ?\r) - ;; So point is correct in other window - (goto-char (point-min)))) - - (if (eq (car folding-stack) 'folded) - (folding-narrow-to-region nil nil t) - (folding-narrow-to-region (marker-position (car (car folding-stack))) - (marker-position (cdr (car folding-stack))) t)) - (and (consp (car folding-stack)) - (set-marker (car (car folding-stack)) nil) - (set-marker (cdr (car folding-stack)) nil)) - (setq folding-stack (cdr folding-stack))) - (error "Outside all folds")) - (folding-set-mode-line)) - -;;}}} -;;{{{ folding-show-current-entry - -(defun folding-show-current-entry (&optional event noerror noskip) - "Opens the fold that the point is on, but does not enter it. -EVENT and optional arg NOERROR means don't signal an error if there is -no fold, just return nil. NOSKIP means don't jump out of a hidden -region first. - -Returns ((START END SUBFOLDS-P). START and END indicate the extents of -the fold that was shown. If SUBFOLDS-P is non-nil, the fold contains -subfolds." - (interactive) - (or noskip - (folding-skip-ellipsis-backward)) - (let ((point (point)) - backward forward start end subfolds-not-p) - (unwind-protect - (or (and (integerp - (car-safe (setq backward (folding-skip-folds t)))) - (integerp - (car-safe (setq forward (folding-skip-folds nil)))) - (progn - (goto-char (car forward)) - (skip-chars-forward "^\r\n") - (setq end (point)) - (skip-chars-forward "\r\n") - (not (and folding-stack (eobp)))) - (progn - (goto-char (car backward)) - (skip-chars-backward "^\r\n") - (setq start (point)) - (skip-chars-backward "\r\n") - (not (and folding-stack (bobp)))) - (progn - (setq point start) - ;; Avoid holding the list through a GC. - (setq subfolds-not-p - (not (or (cdr backward) - (cdr forward)))) - (folding-subst-regions - (append backward (nreverse forward)) - ?\r ?\n) - (list start end (not subfolds-not-p)))) - (if noerror - nil - (error "Not on a fold"))) - (goto-char point)))) - -;;}}} -;;{{{ folding-hide-current-entry - -(defun folding-toggle-enter-exit () - "Run folding-shift-in or folding-shift-out depending on current line's contents." - (interactive) - (beginning-of-line) - (let ((current-line-mark (folding-mark-look-at))) - (if (and (numberp current-line-mark) - (= current-line-mark 0)) - (folding-shift-in) - (folding-shift-out)))) - -(defun folding-toggle-show-hide () - "Run folding-show-current-entry or folding-hide-current-entry depending on current line's contents." - (interactive) - (beginning-of-line) - (let ((current-line-mark (folding-mark-look-at))) - (if (and (numberp current-line-mark) - (= current-line-mark 0)) - (folding-show-current-entry) - (folding-hide-current-entry)))) - -(defun folding-hide-current-entry (&optional event) - "Close the fold around the point using EVENT. -Undo effect of `folding-show-current-entry'." - (interactive) - (folding-skip-ellipsis-backward) - (let (start end) - (if (and (integerp (setq start (car-safe (folding-skip-folds t)))) - (integerp (setq end (car-safe (folding-skip-folds nil))))) - (if (and folding-stack - (or (eq start (point-min)) - (eq end (point-max)))) - ;;(error "Cannot hide current fold") - (folding-shift-out) - (goto-char start) - (skip-chars-backward "^\r\n") - (folding-subst-regions (list start end) ?\n ?\r)) - (error "Not on a fold")))) - -;;}}} -;;{{{ folding-show-all - -(defun folding-show-all () - "Exits all folds, to the top level." - (interactive) - (while folding-stack - (folding-shift-out))) - -;;}}} -;;{{{ folding-goto-line - -(defun folding-goto-line (line) - "Go to LINE, entering as many folds as possible." - (interactive "NGoto line: ") - (folding-show-all) - (goto-char 1) - (and (< 1 line) - (re-search-forward "[\n\C-m]" nil 0 (1- line))) - (let ((goal (point))) - (while (prog2 (beginning-of-line) - (folding-shift-in t) - (goto-char goal)))) - (folding-narrow-to-region - (and folding-narrow-by-default (point-min)) - (point-max) t)) - -;;}}} - -;;}}} -;;{{{ code: Searching for fold boundaries - -;;{{{ folding-skip-folds - -(defun folding-skip-folds (backward &optional outside) - "Skips forward through the buffer (backward if BACKWARD is non-nil) -until it finds a closing fold mark or the end of the buffer. The -point is not moved. Jumps over balanced folding-mark pairs on the way. -Returns t if the end of buffer was found in an unmatched folding-mark -pair, otherwise a list. - -If the point is actually on an fold start mark, the mark is ignored; -if it is on an end mark, the mark is noted. This decision is -reversed if BACKWARD is non-nil. If optional OUTSIDE is non-nil and -BACKWARD is nil, either mark is noted. - -The first element of the list is a position in the end of the closing -fold mark if one was found, or nil. It is followed by (END START) -pairs (flattened, not a list of pairs). The pairs indicating the -positions of folds skipped over; they are positions in the fold -marks, not necessarily at the ends of the fold marks. They are in -the opposite order to that in which they were skipped. The point is -left in a meaningless place. If going backwards, the pairs are -\(START END) pairs, as the fold marks are scanned in the opposite -order. - -Works by maintaining the position of the top and bottom marks found -so far. They are found separately using a normal string search for -the fixed part of a fold mark (because it is faster than a regexp -search if the string does not occur often outside of fold marks), -checking that it really is a proper fold mark, then considering the -earliest one found. The position of the other (if found) is -maintained to avoid an unnecessary search at the next iteration." - (let ((first-mark (if backward folding-bottom-mark folding-top-mark)) - (last-mark (if backward folding-top-mark folding-bottom-mark)) - (top-re folding-top-regexp) - (depth 0) - pairs point - temp - start - first - last - case-fold-search) - ;; Ignore trailing space? - (when nil - (when (and (stringp first-mark) - (string-match "^\\(.*[^ ]+\\) +$" first-mark)) - (setq first-mark (match-string 1 first-mark))) - (when (and (stringp last-mark) - (string-match "^\\(.*[^ ]+\\) +$" last-mark)) - (setq last-mark (match-string 1 last-mark))) - (when (and (stringp top-re) - (string-match "^\\(.*[^ ]+\\) +$" top-re)) - (setq top-re (match-string 1 top-re)))) - (save-excursion - (skip-chars-backward "^\r\n") - (unless outside - (and (eq (preceding-char) ?\r) - (forward-char -1)) - (if (looking-at top-re) - (if backward - (setq last (match-end 1)) - (skip-chars-forward "^\r\n")))) - (while (progn - ;; Find last first, prevents unnecessary searching - ;; for first. - (setq point (point)) - (or last - (while (and (if backward - (search-backward last-mark first t) - (search-forward last-mark first t)) - (progn - (setq temp (point)) - (goto-char (match-beginning 0)) - (skip-chars-backward " \t") - (and (not - (setq last - (if (eq (preceding-char) ?\r) - temp - (and (bolp) temp)))) - (goto-char temp))))) - (goto-char point)) - (or first - (while (and (if backward - (search-backward first-mark last t) - (search-forward first-mark last t)) - (progn - (setq temp (point)) - (goto-char (match-beginning 0)) - (skip-chars-backward " \t") - (and (not - (setq first - (if (eq (preceding-char) ?\r) - temp - (and (bolp) temp)))) - (goto-char temp)))))) - ;; Return value of conditional says whether to - ;; iterate again. - (if (not last) - ;; Return from this with the result. - (not (setq pairs (if first t (cons nil pairs)))) - (if (and first - (if backward - (> first last) - (< first last))) - (progn - (goto-char first) - (if (eq 0 depth) - (setq start first - first nil - depth 1) ;; non-nil value, loop again. - (setq first nil - ;; non-nil value => loop again - depth (1+ depth)))) - (goto-char last) - (if (eq 0 depth) - (not (setq pairs (cons last pairs))) - (or (< 0 (setq depth (1- depth))) - (setq pairs (cons last (cons start pairs)))) - (setq last nil) - t))))) - pairs))) - -;;}}} - -;;}}} -;;{{{ code: Functions that actually modify the buffer - -;;{{{ folding-fold-region - -(defun folding-fold-region (start end) - "Places fold mark at the beginning and end of a specified region. -The region is specified by two arguments START and END. The point is -left at a suitable place ready to insert the title of the fold. - -The fold markers are intended according to mode." - (interactive "r") - (and (< end start) - (setq start (prog1 end - (setq end start)))) - (setq end (set-marker (make-marker) end)) - (goto-char start) - (beginning-of-line) - (setq start (point)) - (insert-before-markers folding-top-mark) - ;; XEmacs latex-mode, after (tex-site), indents the whole - ;; fold 50 characters right. Don't do that. - (unless (string-match "latex" (symbol-name major-mode)) - (indent-according-to-mode)) - (let ((saved-point (point))) - (and folding-secondary-top-mark - (insert-before-markers folding-secondary-top-mark)) - (insert-before-markers ?\n) - (goto-char (marker-position end)) - (set-marker end nil) - (and (not (bolp)) - (eq 0 (forward-line)) - (eobp) - (insert ?\n)) - (insert folding-bottom-mark) - (unless (string-match "latex" (symbol-name major-mode)) - (indent-according-to-mode)) - (insert ?\n) - (setq folding-stack (if folding-stack - (cons (cons (point-min-marker) - (point-max-marker)) - folding-stack) - '(folded))) - (folding-narrow-to-region start (1- (point))) - (goto-char saved-point) - (folding-set-mode-line)) - (save-excursion (folding-tidy-inside))) - -;;}}} -;;{{{ folding-tidy-inside - -;; Note to self: The long looking code for checking and modifying those -;; blank lines is to make sure the text isn't modified unnecessarily. -;; Don't remove it again! - -(defun folding-tidy-inside () - "Add or remove blank lines at the top and bottom of the current fold. -Also adds fold marks at the top and bottom (after asking), if they are not -there already. The amount of space left depends on the variable -`folding-internal-margins', which is one by default." - (interactive) - (if buffer-read-only nil - (let () -;;; (top-re (if (string-match "^\\(.*\\) $" folding-top-mark) -;;; (match-string 1 folding-top-mark) -;;; folding-top-mark)) - (if (folding-use-overlays-p) - (goto-char (- (overlay-end (car folding-narrow-overlays)) 1)) - (goto-char (point-min))) - (and (eolp) - (progn (skip-chars-forward "\n\t ") - (delete-region (point-min) (point)))) - (and (if (let (case-fold-search) (folding-mark-look-at-top-mark-p)) - (progn (forward-line 1) - (and (eobp) (insert ?\n)) - t) - (and (y-or-n-p "Insert missing folding-top-mark? ") - (progn (insert (concat folding-top-mark - "" - (or folding-secondary-top-mark "") - "\n")) - t))) - folding-internal-margins - (<= 0 folding-internal-margins) - (let* ((p1 (point)) - (p2 (progn (skip-chars-forward "\n") (point))) - (p3 (progn (skip-chars-forward "\n\t ") - (skip-chars-backward "\t " p2) (point)))) - (if (eq p2 p3) - (or (eq p2 (setq p3 (+ p1 folding-internal-margins))) - (if (< p2 p3) - (newline (- p3 p2)) - (delete-region p3 p2))) - (delete-region p1 p3) - (or (eq 0 folding-internal-margins) - (newline folding-internal-margins))))) - (if (folding-use-overlays-p) - (goto-char (overlay-start (cdr folding-narrow-overlays))) - (goto-char (point-max))) - (and (bolp) - (progn (skip-chars-backward "\n") - (delete-region (point) (point-max)))) - (beginning-of-line) - (and (or (let (case-fold-search) (folding-mark-look-at-bottom-mark-p)) - (progn (goto-char (point-max)) nil) - (and (y-or-n-p "Insert missing folding-bottom-mark? ") - (progn - (insert (concat "\n" folding-bottom-mark)) - (beginning-of-line) - t))) - folding-internal-margins - (<= 0 folding-internal-margins) - (let* ((p1 (point)) - (p2 (progn (skip-chars-backward "\n") (point))) - (p3 (progn (skip-chars-backward "\n\t ") - (skip-chars-forward "\t " p2) (point)))) - (if (eq p2 p3) - (or (eq p2 (setq p3 (- p1 1 folding-internal-margins))) - (if (> p2 p3) - (newline (- p2 p3)) - (delete-region p2 p3))) - (delete-region p3 p1) - (newline (1+ folding-internal-margins)))))))) - -;;}}} - -;;}}} -;;{{{ code: Operations on the whole buffer - -;;{{{ folding-whole-buffer - -(defun folding-whole-buffer () - "Folds every fold in the current buffer. -Fails if the fold markers are not balanced correctly. - -If the buffer is being viewed in a fold, folds are repeatedly exited to -get to the top level first (this allows the folds to be tidied on the -way out). The buffer modification flag is not affected, and this -function will work on read-only buffers." - - (interactive) - (message "Folding buffer...") - (let ((narrow-min (point-min)) - (narrow-max (point-max)) - folding-list) - (save-excursion - (widen) - (goto-char 1) - (setq folding-list (folding-skip-folds nil t)) - (narrow-to-region narrow-min narrow-max) - (and (eq t folding-list) - (error - "Cannot fold whole buffer -- unmatched begin-fold mark `%s' ´%s'" - (current-buffer) - folding-top-mark)) - (and (integerp (car folding-list)) - (error - "Cannot fold whole buffer -- extraneous end-fold mark `%s' `%s'" - (current-buffer) - folding-bottom-mark)) - (folding-show-all) - (widen) - (goto-char 1) - ;; Do the modifications forwards. - (folding-subst-regions (nreverse (cdr folding-list)) ?\n ?\r)) - (beginning-of-line) - (folding-narrow-to-region nil nil t) - (message "Folding buffer... done"))) - -;;}}} -;;{{{ folding-open-buffer - -(defun folding-open-buffer () - "Unfolds the entire buffer, leaving the point where it is. -Does not affect the buffer-modified flag, and can be used on read-only -buffers." - (interactive) - (message "Unfolding buffer...") - (folding-clear-stack) - (folding-set-mode-line) - (unwind-protect - (progn - (widen) - (folding-subst-regions (list 1 (point-max)) ?\r ?\n)) - (folding-narrow-to-region nil nil t)) - (message "Unfolding buffer... done")) - -;;}}} -;;{{{ folding-convert-buffer-for-printing - -(defun folding-convert-buffer-for-printing (&optional buffer pre-title post-title pad) - "Remove folds from a buffer, for printing. - -It copies the contents of the (hopefully) folded buffer BUFFER into a -buffer called `*Unfolded: *', removing all of the fold -marks. It keeps the titles of the folds, however, and numbers them. -Subfolds are numbered in the form 5.1, 5.2, 5.3 etc., and the titles are -indented to eleven characters. - -It accepts four arguments. BUFFER is the name of the buffer to be -operated on, or a buffer. nil means use the current buffer. PRE-TITLE -is the text to go before the replacement fold titles, POST-TITLE is the -text to go afterwards. Finally, if PAD is non-nil, the titles are all -indented to the same column, which is eleven plus the length of -PRE-TITLE. Otherwise just one space is placed between the number and -the title." - (interactive (list (read-buffer "Remove folds from buffer: " - (buffer-name) - t) - (read-string "String to go before enumerated titles: ") - (read-string "String to go after enumerated titles: ") - (y-or-n-p "Pad section numbers with spaces? "))) - (set-buffer (setq buffer (get-buffer buffer))) - (setq pre-title (or pre-title "") - post-title (or post-title "")) - (or folding-mode - (error "Must be in Folding mode before removing folds")) - (let* ((new-buffer (get-buffer-create (concat "*Unfolded: " - (buffer-name buffer) - "*"))) - (section-list '(1)) - (section-prefix-list '("")) - - (secondary-mark-length (length folding-secondary-top-mark)) - - (secondary-mark folding-secondary-top-mark) - (mode major-mode) - - ;; [jari] Aug 14 1997 - ;; Regexp doesn't allow "footer text" like, so we add one more - ;; regexp to loosen the end criteria - ;; - ;; {{{ Subsubsection 1 - ;; }}} Subsubsection 1 - ;; - ;; was: (regexp folding-regexp) - ;; - (regexp - (concat "\\(^\\|\r\\)\\([ \t]*\\)\\(\\(" - (regexp-quote folding-top-mark) - "\\)\\|\\(" - (regexp-quote folding-bottom-mark) - "[ \t]*.*\\(\\)\\($\\|\r\\)\\)\\)")) - title - prefix) - ;; was obsolete function: (buffer-flush-undo new-buffer) - (buffer-disable-undo new-buffer) - (save-excursion - (set-buffer new-buffer) - (delete-region (point-min) - (point-max))) - (save-restriction - (widen) - (copy-to-buffer new-buffer (point-min) (point-max))) - (display-buffer new-buffer t) - (set-buffer new-buffer) - (subst-char-in-region (point-min) (point-max) ?\r ?\n) - (funcall mode) - (while (re-search-forward regexp nil t) - (if (match-beginning 4) - (progn - (goto-char (match-end 4)) - - ;; - Move after start fold and read the title from there - ;; - Then move back and kill the fold mark - ;; - (setq title - (buffer-substring (point) - (progn (end-of-line) - (point)))) - (delete-region (save-excursion - (goto-char (match-beginning 4)) - (skip-chars-backward "\n\r") - (point)) - (progn - (skip-chars-forward "\n\r") - (point))) - (and (<= secondary-mark-length - (length title)) - (string-equal secondary-mark - (substring title - (- secondary-mark-length))) - (setq title (substring title - 0 - (- secondary-mark-length)))) - (setq section-prefix-list - (cons (setq prefix (concat (car section-prefix-list) - (int-to-string (car section-list)) - ".")) - section-prefix-list)) - (or (cdr section-list) - (insert ?\n)) - (setq section-list (cons 1 - (cons (1+ (car section-list)) - (cdr section-list)))) - (setq title (concat prefix - (if pad - (make-string - (max 2 (- 8 (length prefix))) ? ) - " ") - title)) - (message "Reformatting: %s%s%s" - pre-title - title - post-title) - (insert "\n\n" - pre-title - title - post-title - "\n\n")) - (goto-char (match-beginning 5)) - (or (setq section-list (cdr section-list)) - (error "Too many bottom-of-fold marks")) - - (setq section-prefix-list (cdr section-prefix-list)) - (delete-region (point) - (progn - (forward-line 1) - (point))))) - (and (cdr section-list) - (error - "Too many top-of-fold marks -- reached end of file prematurely")) - (goto-char (point-min)) - (buffer-enable-undo) - (set-buffer-modified-p nil) - (message "All folds reformatted."))) - -;;}}} -;;}}} - -;;{{{ code: Standard fold marks for various major modes - -;;{{{ A function to set default marks, `folding-add-to-marks-list' - -(defun folding-add-to-marks-list (mode top bottom - &optional secondary noforce message) - "Add/set fold mark list for a particular major mode. -When called interactively, asks for a `major-mode' name, and for -fold marks to be used in that mode. It adds the new set to -`folding-mode-marks-alist', and if the mode name is the same as the current -major mode for the current buffer, the marks in use are also changed. - -If called non-interactively, arguments are MODE, TOP, BOTTOM and -SECONDARY. MODE is the symbol for the major mode for which marks are -being set. TOP, BOTTOM and SECONDARY are strings, the three fold marks -to be used. SECONDARY may be nil (as opposed to the empty string), but -the other two must be non-empty strings, and is an optional argument. - -Two other optional arguments are NOFORCE, meaning do not change the -marks if marks are already set for the specified mode if non-nil, and -MESSAGE, which causes a message to be displayed if it is non-nil. This -is also the message displayed if the function is called interactively. - -To set default fold marks for a particular mode, put something like the -following in your .emacs: - -\(folding-add-to-marks-list 'major-mode \"(** {{{ \" \"(** }}} **)\" \" **)\") - -Look at the variable `folding-mode-marks-alist' to see what default settings -already apply. - -`folding-set-marks' can be used to set the fold marks in use in the current -buffer without affecting the default value for a particular mode." - (interactive - (let* ((mode (completing-read - (concat "Add fold marks for major mode (" - (symbol-name major-mode) - "): ") - obarray - (function - (lambda (arg) - (and (commandp arg) - (string-match "-mode\\'" - (symbol-name arg))))) - t)) - (mode (if (equal mode "") - major-mode - (intern mode))) - (object (assq mode folding-mode-marks-alist)) - (old-top (and object - (nth 1 object))) - top - (old-bottom (and object - (nth 2 object))) - bottom - (secondary (and object - (nth 3 object))) - (prompt "Top fold marker: ")) - (and (equal secondary "") - (setq secondary nil)) - (while (not top) - (setq top (read-string prompt (or old-top "{{{ "))) - (and (equal top "") - (setq top nil))) - (setq prompt (concat prompt - top - ", Bottom marker: ")) - (while (not bottom) - (setq bottom (read-string prompt (or old-bottom "}}}"))) - (and (equal bottom "") - (setq bottom nil))) - (setq prompt (concat prompt - bottom - (if secondary - ", Secondary marker: " - ", Secondary marker (none): ")) - secondary (read-string prompt secondary)) - (and (equal secondary "") - (setq secondary nil)) - (list mode top bottom secondary nil t))) - (let ((object (assq mode folding-mode-marks-alist))) - (if (and object - noforce - message) - (message "Fold markers for `%s' are already set." - (symbol-name mode)) - (if object - (or noforce - (setcdr object (if secondary - (list top bottom secondary) - (list top bottom)))) - (setq folding-mode-marks-alist - (cons (if secondary - (list mode top bottom secondary) - (list mode top bottom)) - folding-mode-marks-alist))) - (and message - (message "Set fold marks for `%s' to \"%s\" and \"%s\"." - (symbol-name mode) - (if secondary - (concat top "name" secondary) - (concat top "name")) - bottom) - (and (eq major-mode mode) - (folding-set-marks top bottom secondary)))))) - -;;}}} -;;{{{ Set some useful default fold marks - -(folding-add-to-marks-list 'ada-mode "-- {{{" "-- }}}" nil t) -(folding-add-to-marks-list 'asm-mode "; {{{" "; }}}" nil t) -(folding-add-to-marks-list 'awk-mode "# {{{" "# }}}" nil t) -(folding-add-to-marks-list 'Bison-mode "/* {{{" "/* }}} */" " */" t) -(folding-add-to-marks-list 'LaTeX-mode "%{{{" "%}}}" nil t) -(folding-add-to-marks-list 'TeX-mode "%{{{" "%}}}" nil t) -(folding-add-to-marks-list 'bibtex-mode "%{{{" "%}}} */" nil t) -(folding-add-to-marks-list 'bison-mode "/* {{{" "/* }}} */" " */" t) -(folding-add-to-marks-list 'c++-mode "// {{{" "// }}}" nil t) -(folding-add-to-marks-list 'c-mode "/* {{{" "/* }}} */" " */" t) -(folding-add-to-marks-list 'dcl-mode "! {{{" "! }}}" nil t) -(folding-add-to-marks-list 'change-log-mode "{{{" "}}}" nil t) -(folding-add-to-marks-list 'cperl-mode "# {{{" "# }}}" nil t) -(folding-add-to-marks-list 'emacs-lisp-mode ";;{{{" ";;}}}" nil t) -(folding-add-to-marks-list 'erlang-mode "%%{{{" "%%}}}" nil t) -(folding-add-to-marks-list 'finder-mode "{{{" "}}}" nil t) -(folding-add-to-marks-list 'fortran-mode "! {{{" "! }}}" nil t) -(folding-add-to-marks-list 'f90-mode "! {{{" "! }}}" nil t) -(folding-add-to-marks-list 'generic-mode ";# " ";\$" nil t) -(folding-add-to-marks-list 'gofer-mode "-- {{{" "-- }}}" nil t) -(folding-add-to-marks-list 'html-mode "" " -->" t) -(folding-add-to-marks-list 'icon-mode "# {{{" "# }}}" nil t) -(folding-add-to-marks-list 'indented-text-mode "{{{" "}}}" nil t) -(folding-add-to-marks-list 'java-mode "// {{{" "// }}}" nil t) -(folding-add-to-marks-list 'javascript-mode "// {{{" "// }}}" nil t) -(folding-add-to-marks-list 'jde-mode "// {{{" "// }}}" nil t) -(folding-add-to-marks-list 'ksh-mode "# {{{" "# }}}" nil t) -(folding-add-to-marks-list 'latex-mode "%{{{" "%}}}" nil t) -(folding-add-to-marks-list 'lisp-interaction-mode ";;{{{" ";;}}}" nil t) -(folding-add-to-marks-list 'lisp-mode ";;{{{" ";;}}}" nil t) -(folding-add-to-marks-list 'm4-mode "# {{{" "# }}}" nil t) -(folding-add-to-marks-list 'makefile-mode "# {{{" "# }}}" nil t) -(folding-add-to-marks-list 'matlab-mode "%%%{{{" "%%%}}}" nil t) -(folding-add-to-marks-list 'meta-mode "% {{{" "% }}}" nil t) -(folding-add-to-marks-list 'ml-mode "(* {{{" "(* }}} *)" " *)" t) -(folding-add-to-marks-list 'modula-2-mode "(* {{{" "(* }}} *)" " *)" t) -(folding-add-to-marks-list 'nroff-mode "\\\\ {{{" "\\\\ }}}" nil t) -(folding-add-to-marks-list 'occam-mode "-- {{{" "-- }}}" nil t) -(folding-add-to-marks-list 'orwell-mode "{{{" "}}}" nil t) -(folding-add-to-marks-list 'pascal-mode "{ ((( " "{ ))) }" " }" t) -(folding-add-to-marks-list 'php-mode "// {{{" "// }}}" nil t) -(folding-add-to-marks-list 'perl-mode "# {{{" "# }}}" nil t) -(folding-add-to-marks-list 'plain-TeX-mode "%{{{" "%}}}" nil t) -(folding-add-to-marks-list 'plain-tex-mode "%{{{" "%}}}" nil t) -(folding-add-to-marks-list 'prolog-mode "% {{{" "% }}}" nil t) -(folding-add-to-marks-list 'rexx-mode "/* {{{" "/* }}} */" " */" t) -(folding-add-to-marks-list 'sh-mode "# {{{" "# }}}" nil t) -(folding-add-to-marks-list 'sh-script-mode "# {{{" "# }}}" nil t) -(folding-add-to-marks-list 'shellscript-mode "# {{{" "# }}}" nil t) -(folding-add-to-marks-list 'sgml-mode "" " -->" t) -(folding-add-to-marks-list 'simula-mode "! {{{" "! }}}" nil t) -(folding-add-to-marks-list 'sml-mode "(* {{{" "(* }}} *)" " *)" t) -(folding-add-to-marks-list 'sql-mode "-- {{{" "-- }}}" nil t) -(folding-add-to-marks-list 'tcl-mode "#{{{" "#}}}" nil t) -(folding-add-to-marks-list 'tex-mode "%{{{" "%}}}" nil t) -(folding-add-to-marks-list 'texinfo-mode "@c {{{" "@c {{{endfold}}}" " }}}" t) -(folding-add-to-marks-list 'text-mode "{{{" "}}}" nil t) -(folding-add-to-marks-list 'vhdl-mode "# {{{" "# }}}" nil t) -(folding-add-to-marks-list 'xerl-mode "%%{{{" "%%}}}" nil t) -(folding-add-to-marks-list 'xrdb-mode "! {{{" "! }}}" nil t) - -;; heavy shell-perl-awk programmer in fundamental-mode need # prefix... - -(folding-add-to-marks-list 'fundamental-mode "# {{{" "# }}}" nil t) - -;;}}} - -;;}}} - -;;{{{ code: Gross, crufty hacks that seem necessary - -;; ---------------------------------------------------------------------- -;; The functions here have been tested with Emacs 18.55, Emacs 18.58, -;; Epoch 4.0p2 (based on Emacs 18.58) and XEmacs 19.6. - -;; Note that XEmacs 19.6 can't do selective-display, and its -;; "invisible extents" don't work either, so Folding mode just won't -;; work with that version. - -;; They shouldn't do the wrong thing with later versions of Emacs, but -;; they might not have the special effects either. They may appear to -;; be excessive; that is not the case. All of the peculiar things these -;; functions do is done to avoid some side-effect of Emacs' internal -;; logic that I have met. Some of them work around bugs or unfortunate -;; (lack of) features in Emacs. In most cases, it would be better to -;; move this into the Emacs C code. - -;; Folding mode is designed to be simple to cooperate with as many -;; things as possible. These functions go against that principle at the -;; coding level, but make life for the user bearable. - -;;{{{ folding-subst-regions - -;; Substitute newlines for carriage returns or vice versa. -;; Avoid excessive file locking. - -;; Substitutes characters in the buffer, even in a read-only buffer. -;; Takes LIST, a list of regions specified as sequence in the form -;; (START1 END1 START2 END2 ...). In every region specified by each -;; pair, substitutes each occurence of character FIND by REPLACE. - -;; The buffer-modified flag is not affected, undo information is not -;; kept for the change, and the function works on read-only files. This -;; function is much more efficient called with a long sequence than -;; called for each region in the sequence. - -;; If the buffer is not modified when the function is called, the -;; modified-flag is set before performing all the substitutions, and -;; locking is temporarily disabled. This prevents Emacs from trying to -;; make then delete a lock file for *every* substitution, which slows -;; folding considerably, especially on a slow networked filesystem. -;; Without this, on my system, folding files on startup (and reading -;; other peoples' folded files) takes about five times longer. Emacs -;; still locks the file once for this call under those circumstances; I -;; can't think of a way around that, but it isn't really a problem. - -;; I consider these problems to be a bug in `subst-char-in-region'. - -(defun folding-subst-regions (list find replace) - "Substitute \\r and \\n using LIST FIND REPLACE." - (let ((buffer-read-only buffer-read-only) ;; Protect read-only flag. - (modified (buffer-modified-p)) - (font-lock-mode nil) - (lazy-lock-mode nil) - (overlay-p (folding-use-overlays-p)) - (ask1 (symbol-function 'ask-user-about-supersession-threat)) - (ask2 (symbol-function 'ask-user-about-lock))) - (if lazy-lock-mode ;; no-op: Byte compiler silencer - (setq lazy-lock-mode t)) - (unwind-protect - (progn - (setq buffer-read-only nil) - (or modified - (progn - (fset 'ask-user-about-supersession-threat - '(lambda (&rest x) nil)) - (fset 'ask-user-about-lock - '(lambda (&rest x) nil)) - (set-buffer-modified-p t))) ; Prevent file locking in the loop - (while list - (if overlay-p - (folding-flag-region (car list) (nth 1 list) (eq find ?\n)) - (subst-char-in-region (car list) (nth 1 list) find replace t)) - (setq list (cdr (cdr list))))) - ;; buffer-read-only is restored by the let. - ;; Don't want to change MODIFF time if it was modified before. - (or modified - (unwind-protect - (set-buffer-modified-p nil) - (fset 'ask-user-about-supersession-threat ask1) - (fset 'ask-user-about-lock ask2)))))) - -;;}}} -;;{{{ folding-narrow-to-region - -;; Narrow to region, without surprising displays. - -;; Similar to `narrow-to-region', but also adjusts window-start to be -;; the start of the narrowed region. If an optional argument CENTRE is -;; non-nil, the window-start is positioned to leave the point at the -;; centre of the window, like `recenter'. START may be nil, in which -;; case the function acts more like `widen'. - -;; Actually, all the window-starts for every window displaying the -;; buffer, as well as the last_window_start for the buffer are set. The -;; points in every window are set to the point in the current buffer. -;; All this logic is necessary to prevent the display getting really -;; weird occasionally, even if there is only one window. Try making -;; this function like normal `narrow-to-region' with a touch of -;; `recenter', then moving around lots of folds in a buffer displayed in -;; several windows. You'll see what I mean. - -;; last_window_start is set by making sure that the selected window is -;; displaying the current buffer, then setting the window-start, then -;; making the selected window display another buffer (which sets -;; last_window_start), then setting the selected window to redisplay the -;; buffer it displayed originally. - -;; Note that whenever window-start is set, the point cannot be moved -;; outside the displayed area until after a proper redisplay. If this -;; is possible, centre the display on the point. - -;; In Emacs 19; Epoch or XEmacs, searches all screens for all -;; windows. In Emacs 19, they are called "frames". - -(defun folding-narrow-to-region (&optional start end centre) - "Narrow to region START END, possibly CENTRE." - (let* ((the-window (selected-window)) - (selected-buffer (window-buffer the-window)) - (window-ring the-window) - (window the-window) - (point (point)) - (buffer (current-buffer)) - temp) - (unwind-protect - (progn - (unwind-protect - (progn - (if (folding-use-overlays-p) - (if start - (folding-narrow-aux start end t) - (folding-narrow-aux nil nil nil)) - (if start - (narrow-to-region start end) - (widen))) - - (setq point (point)) - (set-window-buffer window buffer) - - (while (progn - (and (eq buffer (window-buffer window)) - (if centre - (progn - (select-window window) - (goto-char point) - (vertical-motion - (- (lsh (window-height window) -1))) - (set-window-start window (point)) - (set-window-point window point)) - (set-window-start window (or start 1)) - (set-window-point window point))) - - (not (eq (setq window (next-window window nil t)) - window-ring))))) - nil ;; epoch screen - (select-window the-window)) ;; unwind-protect INNER - ;; Set last_window_start. - (unwind-protect - (if (not (eq buffer selected-buffer)) - (set-window-buffer the-window selected-buffer) - (if (get-buffer "*scratch*") - (set-window-buffer the-window (get-buffer "*scratch*")) - (set-window-buffer - the-window (setq temp (generate-new-buffer " *temp*")))) - (set-window-buffer the-window buffer)) - (and temp - (kill-buffer temp)))) - ;; Undo this side-effect of set-window-buffer. - (set-buffer buffer) - (goto-char (point))))) - -;;}}} - -;;}}} - -;;{{{ code: folding-end-mode-quickly - -(defun folding-end-mode-quickly () - "Replace all ^M's with linefeeds and widen a folded buffer. -Only has any effect if Folding mode is active. - -This should not in general be used for anything. It is used when changing -major modes, by being placed in kill-mode-tidy-alist, to tidy the buffer -slightly. It is similar to `(folding-mode 0)', except that it does not -restore saved keymaps etc. Repeat: Do not use this function. Its -behaviour is liable to change." - (and (boundp 'folding-mode) - (assq 'folding-mode - (buffer-local-variables)) - folding-mode - (progn - (if (folding-use-overlays-p) - (folding-narrow-to-region nil nil) - (widen)) - (folding-clear-stack) - (folding-subst-regions (list 1 (point-max)) ?\r ?\n)))) - -;;{{{ folding-eval-current-buffer-open-folds - -(defun folding-eval-current-buffer-open-folds (&optional printflag) - "Evaluate all of a folded buffer as Lisp code. -Unlike `eval-current-buffer', this function will evaluate all of a -buffer, even if it is folded. It will also work correctly on non-folded -buffers, so is a good candidate for being bound to a key if you program -in Emacs-Lisp. - -It works by making a copy of the current buffer in another buffer, -unfolding it and evaluating it. It then deletes the copy. - -Programs can pass argument PRINTFLAG which controls printing of output: -nil means discard it; anything else is stream for print." - (interactive) - (if (or (and (boundp 'folding-mode) - folding-mode)) - (let ((temp-buffer - (generate-new-buffer (buffer-name)))) - (message "Evaluating unfolded buffer...") - (save-restriction - (widen) - (copy-to-buffer temp-buffer 1 (point-max))) - (set-buffer temp-buffer) - (subst-char-in-region 1 (point-max) ?\r ?\n) - (let ((real-message-def (symbol-function 'message)) - (suppress-eval-message)) - (fset 'message - (function - (lambda (&rest args) - (setq suppress-eval-message t) - (fset 'message real-message-def) - (apply 'message args)))) - (unwind-protect - (eval-current-buffer printflag) - (fset 'message real-message-def) - (kill-buffer temp-buffer)) - (or suppress-eval-message - (message "Evaluating unfolded buffer... Done")))) - (eval-current-buffer printflag))) - -;;}}} - -;;}}} - -;;{{{ code: ISearch support, walks in and out of folds - -;; This used to be a package of it's own. -;; Requires Emacs 19 or XEmacs. Does not work under Emacs 18. - -;;{{{ Variables - -(defcustom folding-isearch-install t - "*When non-nil, the isearch commands will handle folds." - :type 'boolean - :group 'folding) - -(defvar folding-isearch-stack nil - "Temporary storage for `folding-stack' during isearch.") - -;; Lists of isearch commands to replace - -;; These do normal searching. - -(defvar folding-isearch-normal-cmds - '(isearch-repeat-forward - isearch-repeat-backward - isearch-toggle-regexp - isearch-toggle-case-fold - isearch-delete-char - isearch-abort - isearch-quote-char - isearch-other-control-char - isearch-other-meta-char - isearch-return-char - isearch-exit - isearch-printing-char - isearch-whitespace-chars - isearch-yank-word - isearch-yank-line - isearch-yank-kill - isearch-*-char - isearch-\|-char - isearch-mode-help - isearch-yank-x-selection - isearch-yank-x-clipboard) - "List if isearch commands doing normal search.") - -;; Enables the user to edit the search string - -;; Missing, present in XEmacs isearch-mode.el. Not necessary? -;; isearch-ring-advance-edit, isearch-ring-retreat-edit, isearch-complete-edit -;; isearch-nonincremental-exit-minibuffer, isearch-yank-x-selection, -;; isearch-yank-x-clipboard - -(defvar folding-isearch-edit-enter-cmds - '(isearch-edit-string - isearch-ring-advance - isearch-ring-retreat - isearch-complete) ; (Could also stay in search mode!) - "List of isearch commands which enters search string edit.") - -;; Continues searching after editing. - -(defvar folding-isearch-edit-exit-cmds - '(isearch-forward-exit-minibuffer ; Exits edit - isearch-reverse-exit-minibuffer - isearch-nonincremental-exit-minibuffer) - "List of isearch commands which exits search string edit.") - -;;}}} -;;{{{ Keymaps (an Isearch hook) - -(defvar folding-isearch-mode-map nil - "Modified copy of the isearch keymap.") - -;; Create local copies of the keymaps. The `isearch-mode-map' is -;; copied to `folding-isearch-mode-map' while `minibuffer-local-isearch-map' -;; is made local. (Its name is used explicitly.) -;; -;; Note: This is called every time the search is started. - -(defun folding-isearch-hook-function () - "Update the isearch keymaps for usage with folding mode." - (if (and (boundp 'folding-mode) folding-mode) - (let ((cmds (append folding-isearch-normal-cmds - folding-isearch-edit-enter-cmds - folding-isearch-edit-exit-cmds))) - (setq folding-isearch-mode-map (copy-keymap isearch-mode-map)) - (make-local-variable 'minibuffer-local-isearch-map) - ;; Make sure the destructive operations below doesn't alter - ;; the global instance of the map. - (setq minibuffer-local-isearch-map - (copy-keymap minibuffer-local-isearch-map)) - (setq folding-isearch-stack folding-stack) - (while cmds - (substitute-key-definition - (car cmds) - (intern (concat "folding-" (symbol-name (car cmds)))) - folding-isearch-mode-map) - (substitute-key-definition - (car cmds) - (intern (concat "folding-" (symbol-name (car cmds)))) - minibuffer-local-isearch-map) - (setq cmds (cdr cmds))) - ;; Install our keymap - (cond - (folding-xemacs-p - (let ((f 'set-keymap-name)) - (funcall f folding-isearch-mode-map 'folding-isearch-mode-map)) - ;; Later version of XEmacs (21.2+) use overriding-local-map - ;; for isearch keymap rather than fiddling with - ;; minor-mode-map-alist. This is so isearch keymaps take - ;; precedence over extent-local keymaps. We will support - ;; both ways here. Keymaps will be restored as side-effect - ;; of isearch-abort and isearch-quit - (cond - ;; if overriding-local-map is in use - ((and (boundp 'overriding-local-map) overriding-local-map) - (set-keymap-parent folding-isearch-mode-map overriding-local-map) - (setq overriding-local-map folding-isearch-mode-map)) - ;; otherwise fiddle with minor-mode-map-alist - (t - (setq minor-mode-map-alist - (cons (cons 'isearch-mode folding-isearch-mode-map) - (delq (assoc 'isearch-mode minor-mode-map-alist) - minor-mode-map-alist)))))) - ((boundp 'overriding-terminal-local-map) - (funcall (symbol-function 'set) - 'overriding-terminal-local-map folding-isearch-mode-map)) - ((boundp 'overriding-local-map) - (setq overriding-local-map folding-isearch-mode-map)))))) - -;; Undoes the `folding-isearch-hook-function' function. - -(defun folding-isearch-end-hook-function () - "Actions to perform at the end of isearch in folding mode." - (when (and (boundp 'folding-mode) folding-mode) - (kill-local-variable 'minibuffer-local-isearch-map) - (setq folding-stack folding-isearch-stack))) - -(when folding-isearch-install - (add-hook 'isearch-mode-hook 'folding-isearch-hook-function) - (add-hook 'isearch-mode-end-hook 'folding-isearch-end-hook-function)) - -;;}}} -;;{{{ Normal search routines - -;; Generate the replacement functions of the form: -;; (defun folding-isearch-repeat-forward () -;; (interactive) -;; (folding-isearch-general 'isearch-repeat-forward)) - -(let ((cmds folding-isearch-normal-cmds)) - (while cmds - (eval - (` (defun (, (intern (concat "folding-" (symbol-name (car cmds))))) () - "Automatically generated" - (interactive) - (folding-isearch-general (quote (, (car cmds))))))) - (setq cmds (cdr cmds)))) - -;; The HEART! Executes command and updates the foldings. -;; This is capable of detecting a `quit'. - -(defun folding-isearch-general (function) - "Execute isearch command FUNCTION and adjusts the folding." - (let* ((quit-isearch nil) - (area-beg (point-min)) - (area-end (point-max)) - pos) - (cond - (t - (save-restriction - (widen) - (condition-case nil - (funcall function) - (quit (setq quit-isearch t))) - (setq pos (point))) - ;; Situation - ;; o user has folded buffer - ;; o He manually narrows, say to function ! - ;; --> there is no fold marks at the beg/end --> this is not a fold - (condition-case nil - ;; "current mode has no fold marks..." - (folding-region-has-folding-marks-p area-beg area-end) - (error (setq quit-isearch t))) - (folding-goto-char pos))) - (if quit-isearch - (signal 'quit '(isearch))))) - -;;}}} -;;{{{ Edit search string support - -(defvar folding-isearch-current-buffer nil - "The buffer we are editing, so we can widen it when in minibuffer.") - -;; Functions which enters edit mode. - -(defun folding-isearch-edit-string () - "Replace `isearch-edit-string' when in `folding-mode'." - (interactive) - (folding-isearch-start-edit 'isearch-edit-string)) - -(defun folding-isearch-ring-advance () - "Replace `isearch-ring-advance' when in `folding-mode'." - (interactive) - (folding-isearch-start-edit 'isearch-ring-advance)) - -(defun folding-isearch-ring-retreat () - "Replace `isearch-ring-retreat' when in `folding-mode'." - (interactive) - (folding-isearch-start-edit 'isearch-ring-retreat)) - -(defun folding-isearch-complete () - "Replace `isearch-complete' when in `folding-mode'." - (interactive) - (folding-isearch-start-edit 'isearch-complete)) - -;; Start and wait for editing. When (funcall fnk) returns -;; we are back in interactive search mode. -;; -;; Store match data! - -(defun folding-isearch-start-edit (function) - "Edit with function FUNCTION." - (let (pos) - (setq folding-isearch-current-buffer (current-buffer)) - (save-restriction - (funcall function) - ;; Here, we are widened, by folding-isearch-*-exit-minibuffer. - (setq pos (point))) - (folding-goto-char pos))) - -;; Functions which exits edit mode. - -;; The `widen' below will be caught by the `save-restriction' above, thus -;; this will not cripple `folding-stack'. - -(defun folding-isearch-forward-exit-minibuffer () - "Replace `isearch-forward-exit-minibuffer' when in `folding-mode'." - (interactive) - ;; Make sure we can continue searching outside narrowing. - (save-excursion - (set-buffer folding-isearch-current-buffer) - (widen)) - (isearch-forward-exit-minibuffer)) - -(defun folding-isearch-reverse-exit-minibuffer () - "Replace `isearch-reverse-exit-minibuffer' when in `folding-mode'." - (interactive) - ;; Make sure we can continue searching outside narrowing. - (save-excursion - (set-buffer folding-isearch-current-buffer) - (widen)) - (isearch-reverse-exit-minibuffer)) - -(defun folding-isearch-nonincremental-exit-minibuffer () - "Replace `isearch-reverse-exit-minibuffer' when in `folding-mode'." - (interactive) - ;; Make sure we can continue searching outside narrowing. - (save-excursion - (set-buffer folding-isearch-current-buffer) - (widen)) - (isearch-nonincremental-exit-minibuffer)) - -;;}}} -;;{{{ Special XEmacs support - -;; In XEmacs, all isearch commands must have the property `isearch-command'. - -(if folding-xemacs-p - (let ((cmds (append folding-isearch-normal-cmds - folding-isearch-edit-enter-cmds - folding-isearch-edit-exit-cmds))) - (while cmds - (put (intern (concat "folding-" (symbol-name (car cmds)))) - 'isearch-command t) - (setq cmds (cdr cmds))))) - -;;}}} -;;{{{ General purpose function. - -(defun folding-goto-char (pos) - "Goto character POS, changing fold if necessary." - ;; Make sure POS is inside the visible area of the buffer. - (goto-char pos) - (if (eq pos (point)) ; Point inside narrowed area? - nil - (folding-show-all) ; Fold everything and goto top. - (goto-char pos)) - ;; Enter if point is folded. - (if (folding-point-folded-p pos) - (progn - (folding-shift-in) ; folding-shift-in can change the pos. - (setq folding-isearch-stack folding-stack) - (setq folding-stack '(folded)) - (goto-char pos)))) - -(defun folding-point-folded-p (pos) - "Non-nil when POS is not visible." - (if (folding-use-overlays-p) - (let ((overlays (overlays-at (point))) - (found nil)) - (while (and (not found) (overlayp (car overlays))) - (setq found (overlay-get (car overlays) 'fold) - overlays (cdr overlays))) - found) - (save-excursion - (goto-char pos) - (beginning-of-line) - (skip-chars-forward "^\r" pos) - (not (eq pos (point)))))) - -;;}}} - -;;}}} -;;{{{ code: Additional functions - -(defvar folding-comment-folding-table - '((c-mode - folding-comment-c-mode - folding-uncomment-c-mode)) - "Table of functions to comment and uncomment folds. -Function is called with two arguments: - - number start of fold mark - marker end of fold mark - -Function must return: - - (beg . end) start of fold, end of fold - -Table Format: - '((MAJOR-MODE COMMENT-FUNCTION UNCOMMENT-FUNCTION) ..)") - -(defun folding-insert-advertise-folding-mode () - "Insert Small text describing where to the get the folding at point. -This may be useful 'banner' to inform other people why your code -is formatted like it is and how to view it correctly." - (interactive) - (let* ((prefix "") - (re (or comment-start-skip - (and comment-start - (concat "^[ \t]*" comment-start "+[ \t]*"))))) - - (when re - (save-excursion - (beginning-of-line) - (when (or (re-search-forward re nil t) - (progn - (goto-char (point-min)) - (re-search-forward re nil t))) - (setq prefix (match-string 0))))) - - (beginning-of-line) - (dolist (line - (list - "File layout controlled by Emacs folding.el available at: " - folding-package-url-location)) - (insert "\n" prefix line)))) - -(defun folding-uncomment-mode-generic (beg end tag) - "In region (BEG . END) remove two TAG lines." - (re-search-forward tag (marker-position end)) - (beginning-of-line) - (kill-line 1) - (re-search-forward tag (marker-position end)) - (beginning-of-line) - (kill-line 1) - (cons beg end)) - -(defun folding-comment-mode-generic (beg end tag1 &optional tag2) - "Return (BEG . END) and Add two TAG1 and TAG2 lines." - (insert tag1) - (goto-char (marker-position end)) - (insert (or tag2 tag1)) - (cons beg end)) - -(defun folding-uncomment-c-mode (beg end) - "Uncomment region BEG END." - (folding-uncomment-mode-generic - beg end (regexp-quote " comment /* FOLDING -COM- */"))) - -(defun folding-comment-c-mode (beg end) - "Comment region BEG END." - (let* ((tag " /* FOLDING -COM- */")) - (folding-comment-mode-generic - beg end - (concat "#if comment" tag "\n") - (concat "#endif comment" tag "\n")))) - -(defun folding-comment-fold (&optional uncomment) - "Comment or UNCOMMENT all text inside single fold. -If there are subfolds this function won't work as expected. -User must know that there are no subfolds. - -The heading has -COM- at the end when the fold is commented. -Point must be over fold heading {{{ when function is called. - -Note: - - You can use this function only in modes that do _not_ have - `comment-end'. Ie. don't use this function in modes like C (/* */), because - nested comments are not allowed. See this: - - /* {{{ fold */ - code /* comment of the code */ - /* }}} */ - - Fold can't know how to comment the `code' inside fold, because comments - do not nest. - -Implementation detail: - - {{{ FoldHeader-COM- - - If the fold header has -COM- at the end, then the fold is supposed to - be commented. And if there is no -COM- then fold will be considered - as normal fold. Do not loose or add the -COM- yourself or it will - confuse the state of the fold. - -References: - - `folding-comment-folding-table'" - (interactive "P") - (let* ((state (folding-mark-look-at 'move)) - (closed (eq 0 state)) - (id "-COM-") - (opoint (point)) - (mode-elt (assq major-mode folding-comment-folding-table)) - comment - ret - beg - end) - (unless mode-elt - (if (stringp (nth 2 (folding-get-mode-marks major-mode))) - (error "\ -Folding: function usage error, mode with `comment-end' is not supported."))) - (when (or (null comment-start) - (not (string-match "[^ \t\n]" comment-start))) - (error "Empty comment-start.")) - (unless (memq state '( 0 1 11)) - (error "Incorrect fold state. Point must be over {{{.")) - ;; There is nothing to do if this fold heading does not have - ;; the ID when uncommenting the fold. - (setq state (looking-at (concat ".*" id))) - (when (or (and uncomment state) - (and (null uncomment) (null state))) - (when closed (save-excursion (folding-show-current-entry))) - (folding-pick-move) ;Go to end - (beginning-of-line) - (setq end (point-marker)) - (goto-char opoint) ;And off the fold heading - (forward-line 1) - (setq beg (point)) - (setq comment (concat comment-start id)) - (cond - (mode-elt - (setq ret - (if uncomment - (funcall (nth 2 mode-elt) (point) end) - (funcall (nth 1 mode-elt) (point) end))) - (goto-char (cdr ret))) - (uncomment - (while (< (point) (marker-position end)) - (if (looking-at comment) - (delete-region (point) (match-end 0))) - (forward-line 1))) - (t - (while (< (point) (marker-position end)) - (if (not (looking-at comment)) - (insert comment)) - (forward-line 1)))) - (setq end nil) ;kill marker - ;; Remove the possible tag from the fold name line - (goto-char opoint) - (setq id (concat (or comment-start "") id (or comment-end ""))) - (if (re-search-forward (regexp-quote id) beg t) - (delete-region (match-beginning 0) (match-end 0))) - (when (null uncomment) - (end-of-line) - (insert id)) - (if closed - (folding-hide-current-entry)) - (goto-char opoint)))) - -(defun folding-convert-to-major-folds () - "Convert fold mark items according to `major-mode'. -This function replaces all fold markings }}} and {{{ -with major mode's fold marks. - -As a side effect also corrects all foldings to standard notation. -Eg. following, where correct folding-beg should be \"#{{{ \" -Note that /// marks foldings. - - /// ;wrong fold - # /// ;too many spaces, fold format error - # ///title ;ok, but title too close - - produces - - #/// - #/// - #/// title - -You must 'unfold' whole buffer before using this function." - (interactive) - (let (case-fold-search - (bm "{{{") ; begin match mark - (em "}}}") ; - el ; element - b ; begin - e ; end - e2 ; end2 - pp) - (catch 'out ; is folding active/loaded ?? - (unless (setq el (folding-get-mode-marks major-mode)) - (throw 'out t)) ; ** no mode found - ;; ok , we're in business. Search whole buffer and replace. - (setq b (elt el 0) - e (elt el 1) - e2 (or (elt el 2) "")) - (save-excursion - (goto-char (point-min)) ; start from the beginning of buffer - (while (re-search-forward (regexp-quote bm) nil t) - ;; set the end position for fold marker - (setq pp (point)) - (beginning-of-line) - (if (looking-at (regexp-quote b)) ; should be mode-marked; ok, ignore - (goto-char pp) ; note that beg-of-l cmd, move rexp - (delete-region (point) pp) - (insert b) - (when (not (string= "" e2)) - (unless (looking-at (concat ".*" (regexp-quote e2))) - ;; replace with right fold mark - (end-of-line) - (insert e2))))) - ;; handle end marks , identical func compared to prev. - (goto-char (point-min)) - (while (re-search-forward (regexp-quote em)nil t) - (setq pp (point)) - (beginning-of-line) - (if (looking-at (regexp-quote e)) - (goto-char pp) - (delete-region (point) (progn (end-of-line) (point))) - (insert e))))))) - -(defun folding-all-comment-blocks-in-region (beg end) - "Put all comments in folds inside BEG END. -Notice: Make sure there is no interfering folds inside the area, -because the results may and up corrupted. - -This only works for modes that DO NOT have `comment-end'. -The `comment-start' must be left flushed in order to counted in. - -After this - - ;; comment - ;; comment - - code - - ;; comment - ;; comment - - code - -The result will be: - - ;; {{{ 1 - - ;; comment - ;; comment - - ;; }}} - - code - - ;; {{{ 2 - - ;; comment - ;; comment - - ;; }}} - - code" - (interactive "*r") - - (unless comment-start - (error "Folding: Mode does not define `comment-start'")) - - (when (and (stringp comment-end) - (string-match "[^ \t]" comment-end)) - (error "Folding: Mode defines non-empty `comment-end'.")) - (let* ((count 0) - (comment-regexp (concat "^" comment-start)) - (marker (point-marker)) - done) - (multiple-value-bind (left right ignore) - (folding-get-mode-marks) - ;; Bytecomp silencer: variable ignore bound but not referenced - (if ignore (setq ignore ignore)) - ;; %%%{{{ --> "%%%" - (string-match (concat (regexp-quote comment-start) "+") left) - (save-excursion - (goto-char beg) - (beginning-of-line) - (while (re-search-forward comment-regexp nil t) - (move-marker marker (point)) - (setq done nil) - (beginning-of-line) - (forward-line -1) - ;; 2 previous lines Must not contain FOLD beginning already - (unless (looking-at (regexp-quote left)) - (forward-line -1) - (unless (looking-at (regexp-quote left)) - (goto-char (marker-position marker)) - (beginning-of-line) - (insert left " " (int-to-string count) "\n\n") - (incf count) - (setq done t))) - (goto-char (marker-position marker)) - (when done - ;; Try finding pat of the comment block - (if (not (re-search-forward "^[ \t]*$" nil t)) - (goto-char end)) - (open-line 1) - (forward-line 1) - (insert right "\n"))))))) - -;;}}} -;;{{{ code: Overlay support - -(defun folding-use-overlays-p () - "Should folding use overlays?." - (if folding-allow-overlays - (if folding-xemacs-p - ;; See if we can load overlay.el library that comes in 19.15 - ;; This call returns t or nil if load was successful - ;; Note: is there provide statement? Load is so radical - ;; - (load "overlay" 'noerr) - t))) - -(defun folding-flag-region (from to flag) - "Hide or show lines from FROM to TO, according to FLAG. -If FLAG is nil then text is shown, while if FLAG is t the text is hidden." - (let ((inhibit-read-only t) - overlay) - (save-excursion - (goto-char from) - (end-of-line) - (cond - (flag - (setq overlay (make-overlay (point) to)) - (folding-make-overlay-hidden overlay)) - (t - (if (fboundp 'hs-discard-overlays) - (funcall (symbol-function 'hs-discard-overlays) - (point) to 'invisible t))))))) - -(defun folding-make-overlay-hidden (overlay) - "Make OVERLAY hidden." - (overlay-put overlay 'fold t) - ;; (overlay-put overlay 'intangible t) - (overlay-put overlay 'invisible t) - (overlay-put overlay 'owner 'folding)) - -(defun folding-narrow-aux (start end arg) - "Narrow. Make overlay from `point-min' to START. -And from END t `point-min'. If ARG is nil, delete overlays." - (if (null arg) - (cond - (folding-narrow-overlays - (delete-overlay (car folding-narrow-overlays)) - (delete-overlay (cdr folding-narrow-overlays)) - (setq folding-narrow-overlays nil))) - (let ((overlay-beg (make-overlay (point-min) start)) - (overlay-end (make-overlay end (point-max)))) - (overlay-put overlay-beg 'folding-narrow t) - (overlay-put overlay-beg 'invisible t) - (overlay-put overlay-beg 'owner 'folding) - (overlay-put overlay-end 'folding-narrow t) - (overlay-put overlay-end 'invisible t) - (overlay-put overlay-end 'owner 'folding) - (setq folding-narrow-overlays (cons overlay-beg overlay-end))))) - -;;}}} - -;;{{{ code: end of file tag, provide - -(folding-install) - -(provide 'folding) -(provide 'folding-isearch) ;; This used to be a separate package. - -(run-hooks 'folding-load-hook) - -;;}}} - -;;; folding.el ends here diff --git a/emacs_el/tiny-tools/other/tiny-autoload-loaddefs-other.el b/emacs_el/tiny-tools/other/tiny-autoload-loaddefs-other.el deleted file mode 100644 index ba308fe..0000000 --- a/emacs_el/tiny-tools/other/tiny-autoload-loaddefs-other.el +++ /dev/null @@ -1,390 +0,0 @@ -;;; tiny-autoload-loaddefs-other.el -- loaddef definitions of program files -;; Generate date: 2002-01-02 -;; This file is automatically generated. Do not Change. - -(provide 'tiny-autoload-loaddefs-other) - - -;;;### (autoloads (set-modified-alist modify-alist remove-alist set-alist -;;;;;; del-alist put-alist) "alist" "alist.el" (14456 65500)) -;;; Generated autoloads from alist.el - -(autoload (quote put-alist) "alist" "\ -Modify ALIST to set VALUE to ITEM. -If there is a pair whose car is ITEM, replace its cdr by VALUE. -If there is not such pair, create new pair (ITEM . VALUE) and -return new alist whose car is the new pair and cdr is ALIST. -[tomo's ELIS like function]" nil nil) - -(autoload (quote del-alist) "alist" "\ -If there is a pair whose key is ITEM, delete it from ALIST. -[tomo's ELIS emulating function]" nil nil) - -(autoload (quote set-alist) "alist" "\ -Modify a alist indicated by SYMBOL to set VALUE to ITEM." nil nil) - -(autoload (quote remove-alist) "alist" "\ -Remove ITEM from the alist indicated by SYMBOL." nil nil) - -(autoload (quote modify-alist) "alist" "\ -Modify alist DEFAULT into alist MODIFIER." nil nil) - -(autoload (quote set-modified-alist) "alist" "\ -Modify a value of a symbol SYM into alist MODIFIER. -The symbol SYM should be alist. If it is not bound, -its value regard as nil." nil nil) - -;;;*** - -;;;### (autoloads (c-comment-edit c-comment-edit-at-point) "c-comment-edit2" -;;;;;; "c-comment-edit2.el" (15378 27670)) -;;; Generated autoloads from c-comment-edit2.el - -(defvar c-comment-leader " *" "\ -*Leader used when rebuilding edited C comments. The value of this variable -should be a two-character string. Values of \" \", \" *\" and \"**\" -produce the comment styles: - /* /* /* - ... * ... ** ... - ... * ... ** ... - */ */ */ -respectively.") - -(autoload (quote c-comment-edit-at-point) "c-comment-edit2" "\ -Edit C comment at point. -If point is inside of a comment, the comment is edited. Otherwise, a new -comment is created at point. -" t nil) - -(autoload (quote c-comment-edit) "c-comment-edit2" "\ -Edit multi-line C comments. -This command allows the easy editing of a multi-line C comment like this: - /* - * ... - * ... - */ -The comment may be indented or flush with the left margin. - -If point is within a comment, that comment is used. Otherwise the -comment to be edited is found by searching forward from point. - -With one \\[universal-argument] searching starts after moving back one - paragraph. -With two \\[universal-argument]'s searching starts at the beginning of the - current or proceeding C function. -With three \\[universal-argument]'s searching starts at the beginning of the - current page. -With four \\[universal-argument]'s searching starts at the beginning of the - current buffer (clipping restrictions apply). - -Once located, the comment is copied into a temporary buffer, the comment -leaders and delimiters are stripped away and the resulting buffer is -selected for editing. The major mode of this buffer is controlled by -the variable `c-comment-edit-mode'. - -Use \\[c-comment-edit-end] when you have finished editing the comment. The -comment will be inserted into the original buffer with the appropriate -delimiters and indention, replacing the old version of the comment. If -you don't want your edited version of the comment to replace the -original, use \\[c-comment-edit-abort]." t nil) - -;;;*** - -;;;### (autoloads (cm-install-default cm-minibuffer-completion-help -;;;;;; cm-load-hook) "complete-menu" "complete-menu.el" (15011 59622)) -;;; Generated autoloads from complete-menu.el - -(defvar cm-load-hook (quote (cm-install-default)) "\ -*Hook run when file has been loaded.") - -(autoload (quote cm-minibuffer-completion-help) "complete-menu" "\ -List completions in a menu and copy selction into minibuffer" t nil) - -(autoload (quote cm-install-default) "complete-menu" "\ -Install the X-menuing feature. With ARG, remove X-menuing. VERB. -Note: installation is only possible in X envinronment." t nil) - -;;;*** - -;;;### (autoloads (dired-sort-default-keys dired-resort dired-sort-by-size -;;;;;; dired-sort-by-field dired-sort-by-type dired-sort-by-date) -;;;;;; "dired-sort" "dired-sort.el" (15381 10582)) -;;; Generated autoloads from dired-sort.el - -(autoload (quote dired-sort-by-date) "dired-sort" "\ -In dired, sort the lines by date, newest first. -With ARG, sorts oldest first." t nil) - -(autoload (quote dired-sort-by-type) "dired-sort" "\ -Sort by type, ARG means reverse." t nil) - -(autoload (quote dired-sort-by-field) "dired-sort" "\ -In dired, sort the lines by FIELD (defaults to the mode field)." t nil) - -(autoload (quote dired-sort-by-size) "dired-sort" "\ -In dired, sort the lines by file size, largest first. -With ARG, sorts in the reverse order (smallest first). -All directories are grouped together at the head of the buffer, -and other file types are also grouped." t nil) - -(autoload (quote dired-resort) "dired-sort" "\ -In dired, change the sorting of lines. Prompt for the KIND of sorting. -Non-interactively, takes a sort-kind, and an optional argument for -the associated function. To get a list of such arguments interactively, -call read-dired-resort-args. ARGS are passed to sort." t nil) - -(autoload (quote dired-sort-default-keys) "dired-sort" "\ -Define default bindings to dired map." t nil) - -(add-hook (quote dired-mode-hook) (quote dired-sort-default-keys) (quote end)) - -;;;*** - -;;;### (autoloads (with-expect) "expect" "expect.el" (14954 14938)) -;;; Generated autoloads from expect.el - -(autoload (quote with-expect) "expect" "\ -Set things up for communication with PROGRAM. -FORMS will be evaluated in the normal manner. To talk to the process, -use `expect' and `expect-send'. See the manual for full documentation. -This macro returns nil. - -If PROGRAM is a string, start that program. If PROGRAM is a list, use -the first element of that list as the program and the remainder as the -parameters. If PROGRAM is a process, talk to that process. - -PROGRAM will be started up in a new, fresh temporary buffer. The -buffer will be killed upon completion. If PROGRAM is a process, -a new buffer won't be created, and the buffer won't be killed upon -completion." nil (quote macro)) - -;;;*** - -;;;### (autoloads (fnexpand-complete) "fnexpand" "fnexpand.el" (15378 -;;;;;; 27670)) -;;; Generated autoloads from fnexpand.el - -(defvar fnexpand-executable-enable nil "\ -*if non-nil, then try to expand executable files too. -Beware, this may be time consuming.") - -(autoload (quote fnexpand-complete) "fnexpand" "\ -Expand the file name, env var or command near point" t nil) - -;;;*** - -;;;### (autoloads (folding-mode turn-on-folding-mode turn-off-folding-mode -;;;;;; folding-mode-add-find-file-hook folding-keep-hooked folding-install-hooks -;;;;;; folding-uninstall-hooks folding-mode-hook-no-regexp folding-mode-string -;;;;;; folding-inside-mode-name folding-default-mouse-keys-function -;;;;;; folding-default-keys-function) "folding" "folding.el" (15407 -;;;;;; 51274)) -;;; Generated autoloads from folding.el - -(defvar folding-mode nil "\ -When Non nil, Folding mode is active in the current buffer.") - -(defvar folding-default-keys-function (quote folding-bind-default-keys) "\ -*Function or list of functions used to define keys for Folding mode. -Possible values are: - folding-bind-default-key - The standard keymap. - - `folding-bind-backward-compatible-keys' - Keys used by older versions of Folding mode. This function - does not conform to Emacs 19.29 style conversions concerning - key bindings. The prefix key is C - c - - `folding-bind-outline-compatible-keys' - Define keys compatible with Outline mode. - - `folding-bind-foldout-compatible-keys' - Define some extra keys compatible with Foldout. - -All except `folding-bind-backward-compatible-keys' used the value of -the variable `folding-mode-prefix-key' as prefix the key. -The default is C - c @") - -(defvar folding-default-mouse-keys-function (quote folding-bind-default-mouse) "\ -*Function to bind default mouse keys to `folding-mode-map'.") - -(defvar folding-inside-mode-name "Fld" "\ -*Mode line addition to show inside levels of 'fold' .") - -(defvar folding-mode-string "Fld" "\ -*The minor mode string displayed when mode is on.") - -(defvar folding-mode-hook-no-regexp "RMAIL" "\ -*Regexp which disable automatic folding mode turn on for certain files.") - -(defvar folding-mode-marks-alist nil "\ -List of (major-mode . fold mark) default combinations to use. -When Folding mode is started, the major mode is checked, and if there -are fold marks for that major mode stored in `folding-mode-marks-alist', -those marks are used by default. If none are found, the default values -of \"{{{ \" and \"}}}\" are used. - -Use function `folding-add-to-marks-list' to add more fold marks. The function -also explains the alist use in details. - -Use function `folding-set-local-variables' is you change the current mode's -folding marks during the session.") - -(autoload (quote folding-uninstall-hooks) "folding" "\ -Remove hooks set by folding." t nil) - -(autoload (quote folding-install-hooks) "folding" "\ -Install folding hooks." t nil) - -(autoload (quote folding-keep-hooked) "folding" "\ -Make sure hooks are in their places." nil nil) - -(autoload (quote folding-mode-add-find-file-hook) "folding" "\ -Append `folding-mode-find-file-hook' to the list `find-file-hooks'. - -This has the effect that afterwards, when a folded file is visited, if -appropriate Emacs local variable entries are recognized at the end of -the file, Folding mode is started automatically. - -If `inhibit-local-variables' is non-nil, this will not happen regardless -of the setting of `find-file-hooks'. - -To declare a file to be folded, put `folded-file: t' in the file's -local variables. eg., at the end of a C source file, put: - -/* -Local variables: -folded-file: t -*/ - -The local variables can be inside a fold." t nil) - -(autoload (quote turn-off-folding-mode) "folding" "\ -Turn on folding." nil nil) - -(autoload (quote turn-on-folding-mode) "folding" "\ -Turn on folding." nil nil) - -(autoload (quote folding-mode) "folding" "\ -A folding-editor-like minor mode. ARG INTER. - -These are the basic commands that Folding mode provides: - -\\{folding-mode-map} - -Keys starting with `folding-mode-prefix-key' - -\\{folding-mode-prefix-map} - - folding-convert-buffer-for-printing: - `\\[folding-convert-buffer-for-printing]' - Makes a ready-to-print, formatted, unfolded copy in another buffer. - - Read the documentation for the above functions for more information. - -Overview - - Folds are a way of hierarchically organizing the text in a file, so - that the text can be viewed and edited at different levels. It is - similar to Outline mode in that parts of the text can be hidden from - view. A fold is a region of text, surrounded by special \"fold marks\", - which act like brackets, grouping the text. Fold mark pairs can be - nested, and they can have titles. When a fold is folded, the text is - hidden from view, except for the first line, which acts like a title - for the fold. - - Folding mode is a minor mode, designed to cooperate with many other - major modes, so that many types of text can be folded while they are - being edited (eg., plain text, program source code, Texinfo, etc.). - -Folding-mode function - - If Folding mode is not called interactively (`(interactive-p)' is nil), - and it is called with two or less arguments, all of which are nil, then - the point will not be altered if `folding-folding-on-startup' is set - and `folding-whole-buffer' is called. This is generally not a good - thing, as it can leave the point inside a hidden region of a fold, but - it is required if the local variables set \"mode: folding\" when the - file is first read (see `hack-local-variables'). - - Not that you should ever want to, but to call Folding mode from a - program with the default behavior (toggling the mode), call it with - something like `(folding-mode nil t)'. - -Fold marks - - For most types of folded file, lines representing folds have \"{{{\" - near the beginning. To enter a fold, move the point to the folded line - and type `\\[folding-shift-in]'. You should no longer be able to see - the rest of the file, just the contents of the fold, which you couldn't - see before. You can use `\\[folding-shift-out]' to leave a fold, and - you can enter and exit folds to move around the structure of the file. - - All of the text is present in a folded file all of the time. It is just - hidden. Folded text shows up as a line (the top fold mark) with \"...\" - at the end. If you are in a fold, the mode line displays \"inside n - folds Narrow\", and because the buffer is narrowed you can't see outside - of the current fold's text. - - By arranging sections of a large file in folds, and maybe subsections - in sub-folds, you can move around a file quickly and easily, and only - have to scroll through a couple of pages at a time. If you pick the - titles for the folds carefully, they can be a useful form of - documentation, and make moving though the file a lot easier. In - general, searching through a folded file for a particular item is much - easier than without folds. - -Managing folds - - To make a new fold, set the mark at one end of the text you want in the - new fold, and move the point to the other end. Then type - `\\[folding-fold-region]'. The text you selected will be made into a - fold, and the fold will be entered. If you just want a new, empty fold, - set the mark where you want the fold, and then create a new fold there - without moving the point. Don't worry if the point is in the middle of - a line of text, `folding-fold-region' will not break text in the middle - of a line. After making a fold, the fold is entered and the point is - positioned ready to enter a title for the fold. Do not delete the fold - marks, which are usually something like \"{{{\" and \"}}}\". There may - also be a bit of fold mark which goes after the fold title. - - If the fold markers get messed up, or you just want to see the whole - unfolded file, use `\\[folding-open-buffer]' to unfolded the whole - file, so you can see all the text and all the marks. This is useful for - checking/correcting unbalanced fold markers, and for searching for - things. Use `\\[folding-whole-file]' to fold the buffer again. - - `folding-shift-out' will attempt to tidy the current fold just before - exiting it. It will remove any extra blank lines at the top and bottom, - (outside the fold marks). It will then ensure that fold marks exists, - and if they are not, will add them (after asking). Finally, the number - of blank lines between the fold marks and the contents of the fold is - set to 1 (by default). - -Folding package customisations - - If the fold marks are not set on entry to Folding mode, they are set to - a default for current major mode, as defined by - `folding-mode-marks-alist' or to \"{{{ \" and \"}}}\" if none are - specified. - - To bind different commands to keys in Folding mode, set the bindings in - the keymap `folding-mode-map'. - - The hooks `folding-mode-hook' and `-folding-hook' are - called before folding the buffer and applying the key bindings in - `folding-mode-map'. This is a good hook to set extra or different key - bindings in `folding-mode-map'. Note that key bindings in - `folding-mode-map' are only examined just after calling these hooks; - new bindings in those maps only take effect when Folding mode is being - started. The hook `folding-load-hook' is called when Folding mode is - loaded into Emacs. - -Mouse behavior - - If you want folding to detect point of actual mouse click, please see - variable `folding-mouse-yank-at-p'. - - To customise the mouse actions, look at `folding-behave-table'." t nil) - -;;;*** diff --git a/emacs_el/tiny-tools/tiny/load-path.el b/emacs_el/tiny-tools/tiny/load-path.el deleted file mode 100644 index b824222..0000000 --- a/emacs_el/tiny-tools/tiny/load-path.el +++ /dev/null @@ -1,140 +0,0 @@ -;;; load-path.el --- Used for compiling Emacs lisp files - -;;; Commentary: - -;; -;; File id -;; -;; Copyright (C) 1997-2007 Jari Aalto -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2 of -;; the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be -;; useful, but WITHOUT ANY WARRANTY; without even the implied -;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR -;; PURPOSE. See the GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public -;; License along with program; see the file COPYING. If not, -;; write to the Free Software Foundation, Inc., 51 Franklin -;; Street, Fifth Floor, Boston, MA 02110-1301, USA. -;; -;; Visit for more information -;; -;; Description -;; -;; This file part of the Tiny Tools Kit for Emacs: collection of -;; various utilities. -;; -;; Before compiling, this file is included via -l FILE switch and it -;; defines correct load path in order to find the files that are needed -;; in compilation. If your private directory is not in ~/elisp or -;; ~/lisp then add new path to the place shown below. - -;;; Code: - -(require 'cl) -(setq debug-on-error nil) ;; Must be like this in batch byte compile - -(autoload 'ti::package-autoload-create-on-file "tinylib") -(autoload 'ti::package-autoload-loaddefs-build-recursive "tinylib") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; -;; PLEASE CONFIFURE THIS `dolist' to include paths in your system -;; -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(dolist (path - '( - - ;; Define any new path HERE. It won't matter if you - ;; define non-exiting paths, they are stripped away. - ;; - ;; some users prefer the directory called ~/lisp istead of - ;; ~/elisp (Emacs Lisp) - - "~/elisp" - "~/lisp" - - ;; Unix: Posisbly the best is to have - ;; this directory to be a symbolic link to latest distribution - ;; - ;; Win32: Symbolic links don't work, change this to the absolute - ;; path of the kit location directories. - - "~/elisp/tiny" - "~/elisp/tiny/lisp" - "~/elisp/tiny/lisp/tiny" - "~/elisp/tiny/lisp/other" - - ;; Any other directories that you have in you ~/elips or - - "/usr/share/site-lisp" - "/usr/share/site-lisp/net" - - ;; The best way to keep up with the development is to - ;; use CVS. See BBDB and Gnus sites for CVS. - - "/usr/share/site-lisp/net/cvs-packages" - "/usr/share/site-lisp/net/cvs-packages/bbdb/lisp" - "/usr/share/site-lisp/net/cvs-packages/gnus/lisp" - - ;; Any other directories that you have in you ~/elips or - ;; site wide /usr/share/site-lisp or under /opt hierarchy - - "~/elisp/other" - "~/elisp/bbdb/lisp" ;usually symbolic link to latest - "~/elisp/rc" - "." - ".." - "../other" - "../..")) - (when (file-exists-p path) - (pushnew (expand-file-name path) load-path :test 'string=))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; -;; LOAD PATH self-check -;; -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; ---------------------------------------------------------------------- -;;; -(defun tiny-tmp-load-path-print (&optional function eval) - "Print `load-path' using `function'. -Default is `message'. Eval optional EVAL." - (let ((i 0)) - (if eval - (eval eval)) - (dolist (path load-path) - (if function - (funcall function " %d %s" i path) - (message " %d %s" i path)) - (incf i)))) - -(eval-and-compile - ;; Remove comment if you want to see the load path - ;; before compiling starts. The printed path (order) may give a clue - ;; why compile might have failed. - - ;; (tiny-tmp-load-path-print) - - ;; Check that load-path is in order - (let ((path (locate-library "tinylibm"))) - (if path - nil ;; (message "FOUND: %s" path) - (tiny-tmp-load-path-print) - (message - "\ - ** Can't find library [tinylibm]. Please update - file [load-path.el] which sets up load-path for compilation purposes.")))) - -;;; load-path.el ends here diff --git a/emacs_el/tiny-tools/tiny/tiny-autoload-loaddefs-tiny.el b/emacs_el/tiny-tools/tiny/tiny-autoload-loaddefs-tiny.el deleted file mode 100644 index 2d7a662..0000000 --- a/emacs_el/tiny-tools/tiny/tiny-autoload-loaddefs-tiny.el +++ /dev/null @@ -1,1853 +0,0 @@ -;;; tiny-autoload-loaddefs-tiny.el -- loaddef definitions of program files -;; Generate date: 2002-01-02 -;; This file is automatically generated. Do not Change. - -(provide 'tiny-autoload-loaddefs-tiny) - - -;;;### (autoloads (tiny-setup-autoload-read tiny-setup-display tiny-setup-all -;;;;;; tiny-setup) "tiny-setup" "tiny-setup.el" (15411 19366)) -;;; Generated autoloads from tiny-setup.el - -(autoload (quote tiny-setup) "tiny-setup" "\ -Tiny Tools initial setup controller. See Message buffer for results. - -Please make sure you have run the makefile.pl with build option -\"all\" or \"autoload\". You can verify this by finding files which -contain word \"loaddefs\". - -Autoload statements are always defined when this function is called, -so even if you do not define any options to be installed, they will be -available in callable functions that trigger loading packages. This -means, that you an call e.g function \\[tinytab-mode] and the call -will trigger loading package tinytab.el - -Please notice, that this central setup function configures only the -essential packages, even with TYPE and FEATURE-LIST. The listing -\\[tiny-setup-display] lists many packages that are not loaded -or set up in any default way because a) package's scope is very narrow -and it may not interest the majority b) there is no sensible autoload -and it requires manual settings: tinyload.el and tinypath.el are -good example of this. c) package is a library and it has been -taken cared of by other means. - -Remember that all functions are autoloaded and accessible, although -packages marked may not have default configurations. Here is -sample listing that you may expect from \\[tiny-setup-display] which -displays then content of `tiny-setup-:option-table' when no tiny-setup -configure options are not defined and you should load the package as -instructed in the file itself: - - .. - tinychist - ... - Command history save/restore utility. - tinyload - Load set of packages when Emacs is idle (lazy load). - tinylock - Simple emacs locking utility. - ... - tinynbr - Number conversion minor mode oct/bin/hex. - ... - tinypath - Manage Emacs startup dynamically. - -Here is one way to install packages: a) configure paths automatically b) -load default setup and enable some extra features c) define -delayed loading for some packages that you use most of the time. - - (load \"/ABSOLUTE-PATH/tinypath.el\") - - ;; Define \"ready to use packages\" - - (require 'tiny-setup) - - (tinypath-setup - 'all ;; Activate default features safely - '(tinyeat--bind ;; plus features that you want - tinydesk--bind - tinydiff--bind - tinydired--autoload - tinyeat--bindforce - ..)) - - ;; Delayed loading of these packages, when Emacs goes idle. - - (setq tinyload-:load-list - '(\"tinyadvice\" ;; NOTE: for Emacs only. - \"tinymy\" - \"tinymail\" - \"tinygnus\" - \"tinyigrep\" - ..)) - - (require 'tinyload) - -Here is yet another example. The `tiny-setup' function can configure -only the very basic features, so some defaults for packages -has been changed before they are loaded (look into each file -for interesting things that you may find). - - ;; First, configure some package MANUALLY - - (ti::add-hooks 'tinytf-:mode-define-keys-hook - '(tinytf-mode-define-keys tinytf-mode-define-f-keys)) - - (setq tinymy-:define-key-force t) - (setq tinyef-:mode-key \"\\C-cmr\") - - (setq tinylock-:auto-lock-interval1 45) ;in minutes - - (setq tinyef-:mode-key-table - '( - (?[ . step-delete-back) ;KEY -- action symbol - (?] . step-delete-fwd) - (?* . chunk-delete) - (?; . move-back) - (?' . move-fwd) - (?~ . e-tilde) - (?/ . e-slash) - (?$ . e-dollar))) - - ;; After that, let the contral configure tool do the rest - - (require 'tiny-setup) - - (tiny-setup - 'all - '(tinymy--bind-bindextra - tinytab--bindforce-bindextra - tinysearch--bindmousemeta - tinyreplace--bindemacs - tinyeat--bindforce)) - -The major TYPE of installation can be one of the following: - - 'autoload - - Setup packages so that they are loaded when the options are needed, - but do not define any key-bindings that already exist. This will - bind free keys to trigger loading packages. - - 'all - - Configure with all options on. This will affect free key-bindings. - - nil - - Autoload files are loaded (functions are ready for calling), but - no defaults are configured unless OPTION-LIST is set. - -Alternatively, you can select from OPTION-LIST what packages and what -options inside it will be installed. See list of packages and their -options with command \\[tiny-setup-display] - - The syntax for each package is the same and the symbol passed is - composed from keywords: - - -- Name of package affected, like `tinyeat--'. - - bind Bind default keys. This will set package - to autoload state so that when the binding is called, - package gets loaded. - - bindforce Overwrite any existing binding. This is like bind, but - without a check. - - bindemacs Bind keys that are known to be occupied in Emacs. - - load Load package. If you're tempted to use this, - use more efficient method described in tinyload.el. - Packages that have complex setup or which - can't be autoloaded easily are categorized as \"load\". - - autoload Configure package so, that it will get loaded if option - related to package is needed. - - For example, to enable options in tinyadvice.el and tinyurl.el, you could - send option list below. Notice that multiple options for a package - are separated by single dashes. - - (require 'tiny-setup) - (tinypath-setup 'all '(tinyadvice--load tinyurl--autoload-bind ...)) - | | | - | | Option 2. - | Option 1. - Package." t nil) - -(autoload (quote tiny-setup-all) "tiny-setup" "\ -Setup all tools with TYPE." t nil) - -(autoload (quote tiny-setup-display) "tiny-setup" "\ -List all packages and available setup options. -With Argument, like, \\[universal-argument], list NO-DESCRIPTIONS." t nil) - -(autoload (quote tiny-setup-autoload-read) "tiny-setup" "\ -Read all autoloads. Makefile must have been run for this to work. -Syntax in Tiny Tools kit bin/ directory: perl makefile.pl autoload." nil nil) - -;;;*** - -;;;### (autoloads nil "tinyadvice" "tinyadvice.el" (15384 58070)) -;;; Generated autoloads from tinyadvice.el - (autoload 'tinyadvice-version "tinyadvice" "Display commentary." t) - -;;;*** - -;;;### (autoloads (tinyappend-yank tinyappend-kill tinyappend-beg -;;;;;; tinyappend-end) "tinyappend" "tinyappend.el" (15378 27670)) -;;; Generated autoloads from tinyappend.el - (autoload 'tinyappend-version "tinyappend" "Display commentary." t) - -(autoload (quote tinyappend-end) "tinyappend" "\ -Store region BEG END with MSG or current line to the end of `tinyappend-:buffer'." t nil) - -(autoload (quote tinyappend-beg) "tinyappend" "\ -Store BEG END with MSG or current line to the beginning of `tinyappend-:buffer'." t nil) - -(autoload (quote tinyappend-kill) "tinyappend" "\ -Kill `tinyappend-:buffer' buffer." t nil) - -(autoload (quote tinyappend-yank) "tinyappend" "\ -Yank `tinyappend-:buffer' to the current position. Optionally KILL `tinyappend-:buffer'." t nil) - -;;;*** - -;;;### (autoloads (tinybookmark-mouse tinybookmark-keyboard tinybookmark-mouse-parse -;;;;;; tinybookmark-keyboard-parse tinybookmark-parse tinybookmark-insert -;;;;;; tinybookmark-repeat tinybookmark-forward tinybookmark-backward) -;;;;;; "tinybookmark" "tinybookmark.el" (15378 27670)) -;;; Generated autoloads from tinybookmark.el - -(autoload (quote tinybookmark-backward) "tinybookmark" "\ -Search book mark line backward." t nil) - -(autoload (quote tinybookmark-forward) "tinybookmark" "\ -Search book mark line forward or optionally BACK." t nil) - -(autoload (quote tinybookmark-repeat) "tinybookmark" "\ -Repeats character or string sequence STR COUNT times. - -COUNT can be: - - 0 repeat until position 79 or COL , or if the STR is not single - character, until fits below COL - \"\" interactive insert, as long as user presses RET or SPACE. - -STRICT has effect only if COL is given: - - nil insert as long as STR fits below COL - t insert strictly up till COL and cut away portion - of STR if necessary" t nil) - -(autoload (quote tinybookmark-insert) "tinybookmark" "\ -Add book mark until the end of line. -Normally line is filled as long as the pattern fits below max column, -but if the optional argument is given, it will be filled in _full_ , -truncating if necessary. To see an example, try with some _long_ -pattern. - -Input: - - TXT book mark name - SEP separator string that is repeated. - STRICT - 0 strict is nil in spite of `tinybookmark-:insert-strict' - 1 strict is t in spite of `tinybookmark-:insert-strict' - nil use default value in `tinybookmark-:insert-strict' - -References: - - `tinybookmark-:insert-strict'" t nil) - -(autoload (quote tinybookmark-parse) "tinybookmark" "\ -Builds up book mark list and store it to cache. - -Return: - - t cache was built. - nil book marks not found or error happened. Cache untouched." t nil) - -(autoload (quote tinybookmark-keyboard-parse) "tinybookmark" "\ -Reparse book marks." nil nil) - -(autoload (quote tinybookmark-mouse-parse) "tinybookmark" "\ -Reparse book mark list. This function is called from mouse binding. -Called with mouse EVENT. VERB displays message." t nil) - -(autoload (quote tinybookmark-keyboard) "tinybookmark" "\ -Pass ARG to `tinybookmark-mouse'." t nil) - -(autoload (quote tinybookmark-mouse) "tinybookmark" "\ -Display book mark pop up menu. Use mouse EVENT. -Optional ARG - list \\[universal-argument], reparse list" t nil) - -;;;*** - -;;;### (autoloads (tinybuffer-next-buffer tinybuffer-previous-buffer -;;;;;; tinybuffer-iswitch-to-buffer) "tinybuffer" "tinybuffer.el" -;;;;;; (15378 27670)) -;;; Generated autoloads from tinybuffer.el - (autoload 'tinybuffer-version "tinybuffer" "Display commentary." t) - -(autoload (quote tinybuffer-iswitch-to-buffer) "tinybuffer" "\ -Switch to buffer when RETURN/SPACE/TAB pressed. -Show buffer at echo area. ESC to cancel prompt. - -Note: - - The startup time of calling this function may be high, because it has - to build list of choices and possibly filter out unwanted buffers. - -References: - - `tinybuffer-:iswitch-to-buffer-keys' keys to scroll buffer list" t nil) - -(autoload (quote tinybuffer-previous-buffer) "tinybuffer" "\ -Switch to previous buffer in current window." t nil) - -(autoload (quote tinybuffer-next-buffer) "tinybuffer" "\ -Switch to the other buffer (2nd in list-buffer) in current window." t nil) - -;;;*** - -;;;### (autoloads (tinycache-flush tinycache-flush-all-compilation -;;;;;; tinycache-mode tinycache-buffer-list-mark-cache-off tinycache-buffer-list-mark-deleted -;;;;;; tinycache-buffer-list-unmark tinycache-buffer-list-mark) -;;;;;; "tinycache" "tinycache.el" (15378 27670)) -;;; Generated autoloads from tinycache.el - (autoload 'tinycache-version "tinycache" "Display commentary." t) - -(autoload (quote tinycache-buffer-list-mark) "tinycache" "\ -Mark Cached files in buffer list." t nil) - -(autoload (quote tinycache-buffer-list-unmark) "tinycache" "\ -Mark Cached files in buffer list." t nil) - -(autoload (quote tinycache-buffer-list-mark-deleted) "tinycache" "\ -Mark Cached files in buffer list." t nil) - -(autoload (quote tinycache-buffer-list-mark-cache-off) "tinycache" "\ -Mark files whose cache property has been turned off." t nil) - -(autoload (quote tinycache-mode) "tinycache" "\ -Toggle cache flag for this buffer with ARG. -If the file does not belong to compile cache, calling this function -does nothing. If the file is in the cache, the modeline displays mode name. - -Removing the file from cache means that the file is not killed when -the cache is flushed with \\[tinycache-flush]." t nil) - -(autoload (quote tinycache-flush-all-compilation) "tinycache" "\ -Kill all cached files by stepping through all compilation buffers. VERB." t nil) - -(autoload (quote tinycache-flush) "tinycache" "\ -Kill buffers listed in `tinycache-:cache'. VERB. -You must be in the Compilation/Dired buffer to execute this command. - -If you're not in dired buffer, function tries to find compilation -buffer and kill compilation cached files." t nil) - -;;;*** - -;;;### (autoloads nil "tinychist" "tinychist.el" (15407 48240)) -;;; Generated autoloads from tinychist.el - (autoload 'tinychist-version "tinychist" "Display commentary." t) - -;;;*** - -;;;### (autoloads (tinycomment-indent-for-comment) "tinycomment" -;;;;;; "tinycomment.el" (15378 27670)) -;;; Generated autoloads from tinycomment.el - (autoload 'tinycomment-version "tinycomment" "Display commentary." t) - -(autoload (quote tinycomment-indent-for-comment) "tinycomment" "\ -Alternative to standard `indent-for-comment'. -Relies on file extension -and doesn't need specific mode to be turned on. Temporary buffers -that has no file name cannot be identified by this function, so -it passes control directly to mode. There is a chance you might not -even notice that this function is working on the background. - -Verbose warnings are enabled by `tinycomment-:comment-notify' -Special cases are handled by tinycomment-:comment-extra* variables -Version info is on \\[tinycomment-version]." t nil) - -;;;*** - -;;;### (autoloads nil "tinycompile" "tinycompile.el" (15378 27670)) -;;; Generated autoloads from tinycompile.el - (autoload 'tinycompile-version "tinycompile" "Display commentary." t) - (autoload 'turn-on-tinycompile-mode "tinycompile" "" t) - (autoload 'turn-off-tinycompile-mode "tinycompile" "" t) - (autoload 'tinycompile-mode "tinycompile" "" t) - (autoload 'tinycompile-commentary "tinycompile" "" t) - -;;;*** - -;;;### (autoloads nil "tinydesk" "tinydesk.el" (15411 18780)) -;;; Generated autoloads from tinydesk.el - (autoload 'tinydesk-version "tinydesk" "Display commentary." t) - -;;;*** - -;;;### (autoloads (tinydiff-diff tinydiff-diff-show-noask tinydiff-diff-show) -;;;;;; "tinydiff" "tinydiff.el" (15407 48240)) -;;; Generated autoloads from tinydiff.el - (autoload 'tinydiff-version "tinydiff" "Display commentary." t) - (autoload 'tinydiff-mode "tinydiff" "" t) - (autoload 'turn-on-tinydiff-mode "tinydiff" "" t) - (autoload 'turn-off-tinydiff-mode "tinydiff" "" t) - (autoload 'tinydiff-commentary "tinydiff" "" t) - (autoload 'tinydiff-debug-toggle "tinydiff" "" t) - -(autoload (quote tinydiff-diff-show) "tinydiff" "\ -Generate diff CMD for the buffer and show it in the other window. -Lets user to edit option in the command line." t nil) - -(autoload (quote tinydiff-diff-show-noask) "tinydiff" "\ -Generate diff CMD for the buffer. Guess all parameters." t nil) - -(autoload (quote tinydiff-diff) "tinydiff" "\ -Run diff on buffer, possibly using rcsdiff if file is version controlled. -Inserts contents into register. - -The version control is determined by searching RCS strings 'Id' or 'Log' - -Input: - - CMD diff command - SHOW show the results - NO-ASK run diff without asking any questions. - VERB enable verbose messages - -References: - - `tinydiff-:extra-diff-program' - `tinydiff-:diff-buffer' - `tinydiff-:diff-options' - -Return: - - nil ,the no-ask parameter could not determine right diff. - buffer ,the shell output buffer. Note, that the diff may have - failed, in that case the buffer does not hold valid output." nil nil) - -;;;*** - -;;;### (autoloads (tinydired-switch-to-some-ange-ftp-buffer tinydired-kill-all-ange-buffers -;;;;;; tinydired-kill-all-ange-and-dired-buffers tinydired-kill-dired-and-ange-session -;;;;;; tinydired-load-all-marked-files tinydired-refresh-view tinydired-mark-vc-files-in-Emacs -;;;;;; tinydired-mark-today-files tinydired-pop-to-buffer tinydired-leave-only-lines -;;;;;; tinydired-kill-lines tinydired-kill-unmarked-lines tinydired-last-file -;;;;;; tinydired-first-file tinydired-first-line tinydired-pgdown -;;;;;; tinydired-pgup tinydired-marks-restore tinydired-marks-save -;;;;;; tinydired-shorten-links tinydired-lenghten-links tinydired-dired-do-shell-command -;;;;;; tinydired-one-dir-up tinydired-marked-revert-files tinydired-mark-files-in-Emacs -;;;;;; tinydired-read-dir-as-is tinydired-ediff tinydired-hook-control) -;;;;;; "tinydired" "tinydired.el" (15378 27670)) -;;; Generated autoloads from tinydired.el - -(autoload (quote tinydired-hook-control) "tinydired" "\ -Add hooks to dired mode. Optional REMOVE all hooks inserted by package." t nil) - -(autoload (quote tinydired-ediff) "tinydired" "\ -Compare file at point with file FILE using `ediff'. -FILE defaults to the file at the mark. -The prompted-for file is the first file given to `ediff'. -With prefix arg, prompt for second argument SWITCHES, - which is options for `diff'." t nil) - -(autoload (quote tinydired-read-dir-as-is) "tinydired" "\ -Read the directory without any filtering." t nil) - -(autoload (quote tinydired-mark-files-in-Emacs) "tinydired" "\ -Mark all files in current directory that are in Emacs." t nil) - -(autoload (quote tinydired-marked-revert-files) "tinydired" "\ -Revert ie. replace files in Emacs with true copies in directory. -If ARG is non-nil, remove any marks if file was loaded. - -Exceptions: - Only reload files in Emacs whose modify flag is non-nil. - If file does not exist in Emacs, do nothing." t nil) - -(autoload (quote tinydired-one-dir-up) "tinydired" "\ -Go up one directory." t nil) - -(autoload (quote tinydired-dired-do-shell-command) "tinydired" "\ -Like `dired-do-shell-command', but run running command in dired ange-ftp. -This is not remote shell, but instead it -transfers the file to your local system and then executes the dired -command on the file. - -Remember: Every time you run this command this files are copied _blindly_ -to your local directory. No file cache information is kept. - -Input: - - COMMAND - ARG - -References: - - `tinydired-:tmp-dir'" t nil) - -(autoload (quote tinydired-lenghten-links) "tinydired" "\ -Opposite to `tinydired-shorten-links'. -This may take a while, because the whole directory structure must -be read again." t nil) - -(autoload (quote tinydired-shorten-links) "tinydired" "\ -Shortens all linked files. The link part is removed." t nil) - -(autoload (quote tinydired-marks-save) "tinydired" "\ -Save mark list to private storage. -Use this function if you know next operation will remove the marks. -You can get the marks back with `tinydired-marks-restore'." t nil) - -(autoload (quote tinydired-marks-restore) "tinydired" "\ -Restore mark list saved by `tinydired-marks-save'." t nil) - -(autoload (quote tinydired-pgup) "tinydired" "\ -Move cursor to _last_ file in dired mode." t nil) - -(autoload (quote tinydired-pgdown) "tinydired" "\ -Move cursor up." t nil) - -(autoload (quote tinydired-first-line) "tinydired" "\ -Move to first _line_ in dired." t nil) - -(autoload (quote tinydired-first-file) "tinydired" "\ -Move to first file in dired." t nil) - -(autoload (quote tinydired-last-file) "tinydired" "\ -Move to last file in dired." t nil) - -(autoload (quote tinydired-kill-unmarked-lines) "tinydired" "\ -Remove unmarked lines. Ignore directories and symlinks." t nil) - -(autoload (quote tinydired-kill-lines) "tinydired" "\ -Delete lines matching RE." t nil) - -(autoload (quote tinydired-leave-only-lines) "tinydired" "\ -Leave only lines matching RE. Directory lines are skipped. -You can easily undo this with reverting the buffer (dired \"g\")." t nil) - -(autoload (quote tinydired-pop-to-buffer) "tinydired" "\ -Pop to buffer if it exists in Emacs." t nil) - -(autoload (quote tinydired-mark-today-files) "tinydired" "\ -Mark all files, not dirs, that are created today. -Point sits on first today file. If no today's files are found, point stays -on current filename." t nil) - -(autoload (quote tinydired-mark-vc-files-in-Emacs) "tinydired" "\ -Mark all files in the current _view_ that are in Emacs _and_ in VC control. -Optionally UNMARK. VERB." t nil) - -(autoload (quote tinydired-refresh-view) "tinydired" "\ -Refresh current dired view. -If you have used `tinydired-leave-only-lines' and have done some changes to -the files. You can use this function to re-read the current view. - -The dired \"g\" will load full view back. This instead caches the -current view, executes read, and deletes lines that weren't in the -cache --> you get refreshed view. All this may take a while... - -Input: - - VERB Verbose messages - -Return: - - t if refreshed - nil" t nil) - -(autoload (quote tinydired-load-all-marked-files) "tinydired" "\ -Load all marked files into Emacs. -Does not load files which are already in Emacs. -If ARG is non-nil, remove mark if file was loaded. VERB." t nil) - -(autoload (quote tinydired-kill-dired-and-ange-session) "tinydired" "\ -Kill the current dired buffer and possible ange-ftp buffer. VERB. -This is like `dired-delete-and-exit'." t nil) - -(autoload (quote tinydired-kill-all-ange-and-dired-buffers) "tinydired" "\ -Kill all ange-ftp buffers _and_ all remote dired buffers. VERB." t nil) - -(autoload (quote tinydired-kill-all-ange-buffers) "tinydired" "\ -Kill all ange-ftp process buffers. -If you want to kill one buffer at a time, use -`tinydired-switch-to-some-ange-ftp-buffer' to switch to individual buffer -and use \\[kill-buffer] to kill session. - -This function is primarily used for cleanups. After a while -you may end up with many ftp session and it's nice if -you can get rid of them fast. - -Don't worry about the dired buffers, Ange will automatically -create connection, if you use \"g\" -- rever-buffer, in a dired -that is associated with ange-ftp." t nil) - -(autoload (quote tinydired-switch-to-some-ange-ftp-buffer) "tinydired" "\ -Gather all ange FTP buffers and offer completion menu. -If there is only one Ange buffer, switches to it without asking." t nil) - -;;;*** - -;;;### (autoloads (tinyeat-eat tinyeat-delete-paragraph tinyeat-kill-buffer-lines -;;;;;; tinyeat-kill-buffer-lines-min tinyeat-kill-line-back tinyeat-kill-line -;;;;;; tinyeat-delete-whole-word tinyeat-join-lines tinyeat-forward-preserve -;;;;;; tinyeat-forward tinyeat-backward-preserve tinyeat-backward -;;;;;; tinyeat-zap-line tinyeat-erase-buffer) "tinyeat" "tinyeat.el" -;;;;;; (15378 27672)) -;;; Generated autoloads from tinyeat.el - (autoload 'tinyeat-version "tinyeat" "Display commentary." t) - (autoload 'tinyeat-debug-toggle "tinyeat" "" t) - (autoload 'tinyeat-debug-show "tinyeat" "" t) - -(autoload (quote tinyeat-erase-buffer) "tinyeat" "\ -Erase buffer." t nil) - -(autoload (quote tinyeat-zap-line) "tinyeat" "\ -Kill whole line, including the final newline." t nil) - -(autoload (quote tinyeat-backward) "tinyeat" "\ -Eat backward. See `tinyeat-eat'." t nil) - -(autoload (quote tinyeat-backward-preserve) "tinyeat" "\ -Eat forward, but handle spaces differently. See `tinyeat-eat'." t nil) - -(autoload (quote tinyeat-forward) "tinyeat" "\ -Eat forward. See `tinyeat-eat' function." t nil) - -(autoload (quote tinyeat-forward-preserve) "tinyeat" "\ -Eat forward, but handle spaces differently. See `tinyeat-eat'." t nil) - -(autoload (quote tinyeat-join-lines) "tinyeat" "\ -Join this and next line with one space, and go to the joint." t nil) - -(autoload (quote tinyeat-delete-whole-word) "tinyeat" "\ -Delete word at point. Cursor at whitespace, calls `fixup-whitespace'. - -References: - - `tinyeat-:eat-full-word-charset'" t nil) - -(autoload (quote tinyeat-kill-line) "tinyeat" "\ -Same as `kill-line', except the killed text isn't put into cut buffer. -This way you can retain mouse selection in cut buffer. -This only interests people who can use mouse." t nil) - -(autoload (quote tinyeat-kill-line-back) "tinyeat" "\ -Like `kill-line' but backward." t nil) - -(autoload (quote tinyeat-kill-buffer-lines-min) "tinyeat" "\ -Kill until `point-min'. Optionally BACK." t nil) - -(autoload (quote tinyeat-kill-buffer-lines) "tinyeat" "\ -Kill to the `point-max' or BACK to the `point-min' with ARG." t nil) - -(autoload (quote tinyeat-delete-paragraph) "tinyeat" "\ -Delete current paragraph, separated by empty lines." t nil) - -(autoload (quote tinyeat-eat) "tinyeat" "\ -Eat *appropriate* text forward, if BACK then backward. - -The optional SPACE-PRESERVE changes the space eating (VERB). - -A. when it is NIL and BACK is anything. * marks the cursor. - text1 text1 * text2 text2 - --> text1 text1 text2 text2 ;one space left - -B. when it is NON-NIL and BACK nil - text1 text1 * text2 text2 - --> text1 text1 *text2 text2 ;delete right spaces - -C. when it is NON-NIL and BACK t - text1 text1 * text2 text2 - text1 text1* text2 text2 ;delete left spaces - -References: - - `tinyeat-:non-word-chars'" t nil) - -;;;*** - -;;;### (autoloads nil "tinyef" "tinyef.el" (15378 27672)) -;;; Generated autoloads from tinyef.el - (autoload 'tinyef-mode "tinyef" "" t) - (autoload 'turn-off-tinyef-mode "tinyef" "" t) - (autoload 'turn-on-tinyef-mode "tinyef" "" t) - (autoload 'tinyef-commentary "tinyef" "" t) - (autoload 'tinyef-version "tinyef" "" t) - -;;;*** - -;;;### (autoloads (tinygnus-nslookup-save tinygnus-mark-deleted tinygnus-install) -;;;;;; "tinygnus" "tinygnus.el" (15409 63832)) -;;; Generated autoloads from tinygnus.el - (autoload 'tinygnus-debug-toggle "tinygnus" "" t) - (autoload 'tinygnus-debug-show "tinygnus" "" t) - (autoload 'tinygnus-version "tinygnus" "Display commentary." t) - (autoload 'tinygnus-summary-install-mode "tinygnus" "" t) - (autoload 'tinygnus-summary-mode "tinygnus" "" t) - (autoload 'turn-on-tinygnus-summary-mode "tinygnus" "" t) - (autoload 'turn-off-tinygnus-summary-mode "tinygnus" "" t) - (autoload 'tinygnus-summary-commentary "tinygnus" "" t) - (autoload 'tinygnus-summary-version "tinygnus" "" t) - (autoload 'tinygnus-group-install-mode "tinygnus" "" t) - (autoload 'tinygnus-group-mode "tinygnus" "" t) - (autoload 'turn-on-tinygnus-group-mode "tinygnus" "" t) - (autoload 'turn-off-tinygnus-group-mode "tinygnus" "" t) - (autoload 'tinygnus-group-commentary "tinygnus" "" t) - (autoload 'tinygnus-group-version "tinygnus" "" t) - -(autoload (quote tinygnus-install) "tinygnus" "\ -Install package. Optionally UNINSTALL." t nil) - -(autoload (quote tinygnus-mark-deleted) "tinygnus" "\ -Mark current article expirable(mail) or deleted(news)." t nil) - -(autoload (quote tinygnus-nslookup-save) "tinygnus" "\ -READ or save `tinygnus-:nslookup-table' to `tinygnus-:nslookup-file'. -See function `tinygnus-article-ube-send-to-postmasters'." t nil) - -;;;*** - -;;;### (autoloads (tinyhotlist-remove tinyhotlist-add tinyhotlist-control -;;;;;; tinyhotlist-control-kbd tinyhotlist-load-hotlist tinyhotlist-save-hotlist) -;;;;;; "tinyhotlist" "tinyhotlist.el" (15384 58070)) -;;; Generated autoloads from tinyhotlist.el - -(autoload (quote tinyhotlist-save-hotlist) "tinyhotlist" "\ -Call `tinyhotlist-load-hotlist' with arg to save hotlist. ARGS are ignored." t nil) - -(autoload (quote tinyhotlist-load-hotlist) "tinyhotlist" "\ -Load or SAVE hotlist configuration from `tinyhotlist-:hotlist-file'. -When the hotlist file is loaded, only valid entries from there -are selected to `tinyhotlist-:cache': If File does not exist, it is dropped. - -Return: - - nil t" t nil) - -(autoload (quote tinyhotlist-control-kbd) "tinyhotlist" "\ -Same as `tinyhotlist-control' with ARG, but you can call this from keyboard." t nil) - -(autoload (quote tinyhotlist-control) "tinyhotlist" "\ -Control center of hotlist. Use mouse EVENT to position popup. - -Optional ARG can be: - - nil show the hotlist - 0 kill all members from hotlist. - 9 kill all, but initalize with defaults. - nbr any number, add current active buffer to hotlist - - negative number, remove item from hotlist. Eg. hit \\[universal-argument] - - 1 x \\[universal-argument] remove current buffer from hotlist - 2 x \\[universal-argument] Save hotlist - 3 x \\[universal-argument] load hotlist." t nil) - -(autoload (quote tinyhotlist-add) "tinyhotlist" "\ -Add current buffer to hotlist." t nil) - -(autoload (quote tinyhotlist-remove) "tinyhotlist" "\ -Remove current buffer from hotlist." t nil) - -;;;*** - -;;;### (autoloads (tinyigrep-menu) "tinyigrep" "tinyigrep.el" (15382 -;;;;;; 22904)) -;;; Generated autoloads from tinyigrep.el - -(autoload (quote tinyigrep-menu) "tinyigrep" "\ -Igrep command menu." t nil) - -;;;*** - -;;;### (autoloads (tinyindent-mode tinyindent-tt-mode) "tinyindent" -;;;;;; "tinyindent.el" (15378 27672)) -;;; Generated autoloads from tinyindent.el - (autoload 'tinyindent-version "tinyindent" "Display commentary." t) - -(autoload (quote tinyindent-tt-mode) "tinyindent" "\ -Toggle variable `tinyindent-tt-mode' with ARG. See description in `tinyindent-mode'." t nil) - -(autoload (quote tinyindent-mode) "tinyindent" "\ -Toggle relative indentation mode with ARG. - -Indentation is determined according to previous lines. Special -indent happens only at the beginning of line, where user is asked if -he wants to have relative or \"hard\" indentation. - -Abount function `tinyindent-tt-mode' - -This isn't really mode. It just turns one flag on in `tinyindent-mode', so that -it behaves a little differently. If the `tinyindent-mode' is not running, it -wiil be turned on. turning off `tinyindent-tt-mode' _does_not_ end `tinyindent-mode'. - -Sometimes you want to control between 'hard' tab and 'soft' tab, ie. -relative indent. This mode causes second character to be read after -tab key is hit. The following happens: - -TAB TAB inserts hard tab -TAB SPC indent relative without inserting space char. -TAB x indents relative and inserting character x - -\\{tinyindent-:mode-map}" t nil) - -;;;*** - -;;;### (autoloads (ti::compat-timer-control) "tinylib" "tinylib.el" (15411 -;;;;;; 18540)) -;;; Generated autoloads from tinylib.el - -(autoload (quote ti::compat-timer-control) "tinylib" "\ -With `run-at-time' TIME REPEAT FUNCTION keep or remove timer. VERB." nil nil) - -;;;*** - -;;;### (autoloads (ti::ck-do ti::ck-debug-toggle) "tinylibck" "tinylibck.el" -;;;;;; (15378 27672)) -;;; Generated autoloads from tinylibck.el - -(autoload (quote ti::ck-debug-toggle) "tinylibck" "\ -Turn debug on or off with ARG. See buffer `ti::ck-:debug-buffer'." t nil) - -(autoload (quote ti::ck-do) "tinylibck" "\ -Transform key binding to XEmacs or Emacs in current environment. -on current emacs. This enables you to have same key binding file -for both emacs versions. You can write key bindings either in XEmacs -or Emacs style. - - In Emacs : (ti::ck-do '(meta up)) --> [M-up] - In XEmacs: (ti::ck-do [M-up]) --> '(meta up) - -This function does the conversion only if it needs to, and returns -immediately if no conversion is needed. This should minimise performance -penalty. - -Input: - KEY key sequence - XE flag. If this is nil, then Emacs env. is assumed. However - `ti::ck-:xemacs-flag' is obeyed if it is non-nil. - If non-nil, then XEmacs env. is assumed and conversion to - XEmacs like bindings are done." nil nil) - -;;;*** - -;;;### (autoloads (ti::id-info) "tinylibid" "tinylibid.el" (15378 -;;;;;; 27672)) -;;; Generated autoloads from tinylibid.el - -(autoload (quote ti::id-info) "tinylibid" "\ -Try to identify buffer type. - -Function doesn't rely on mode, because that doesn't necessarily tell what -the buffer holds. Many users still program their shell scripts in -`fundamental-mode' or so. This means that `major-mode' isn't checked, -because calling function can do it easily. - -If this function returns nil, _then_ it's probably the time to check -the `major-mode'. - -The normal order of evaluation is as follows: -- First line in the file -- Whole filename including path = `buffer-file-name' -- File name extension -- `buffer-name' is checked. [temporary buffer has no file name] -- Whole buffer is searched for RE texts - -Input: - - MODE flag, controls return value format - VARIABLE-LOOKUP flag, read buffer type from cache. (From previous call) - VERB if non-nil, verbose messages allowed. - -Return values: - - when optional MODE = nil - Some appropriate _string_ that represents the content. notice that this - string is usually generalised description, _but_ it the file has special - 1st line in form of -*-..-*- the string is direct mode name string. - - when optional MODE = non-nil - Return possible mode name as _symbol_ - - when VARIABLE is non-nil, the variable `ti::id-:info' is read instead. - If it has non-nil value, the value is returned, otherwise full buffer - is parsed again and variable's value is updated. - -References: - - `ti::id-func-alist' order of evaluation. - `ti::id-:info' buffer local variable updated during every call." t nil) - -;;;*** - -;;;### (autoloads (ti::menu-menu ti::menu-set-doc-string ti::menu-add) -;;;;;; "tinylibmenu" "tinylibmenu.el" (15378 27672)) -;;; Generated autoloads from tinylibmenu.el - -(autoload (quote ti::menu-add) "tinylibmenu" "\ -Add to menu MENU-SYMBOL elt (CH . CELL). Optionally DELETE. - -Example: - - (ti::menu-add 'ti::menu-:menu-sample ?2 nil 'delete) - (ti::menu-add 'ti::menu-:menu-sample ?t '( (my-test 1 2 3))) - -Return: - - nil no add done due to existing CELL - no remove due to non-existing CELL" nil nil) - -(autoload (quote ti::menu-set-doc-string) "tinylibmenu" "\ -Use MENU-SYMBOL and set its DOC-STRING. - -Example: - - (ti::menu-set-doc-string 'ti::menu-:menu-sample \"?=help, 1=test1, t=myTest\")" nil nil) - -(autoload (quote ti::menu-menu) "tinylibmenu" "\ -The menu navigation engine. - -Input: - - MENU-SYMBOL variable symbol containing menu items - PFX-ARG the prefix arg user ppossibly passed to menu - -References: - - `ti::menu-:menu-sample' Show how the menu is constructed. - `ti::menu-:prefix-arg' Copy of current prefix arg" nil nil) - -;;;*** - -;;;### (autoloads (ti::text-mark-region ti::text-unmark-region ti::text-mouse-unmark-region -;;;;;; ti::text-mouse-mark-region ti::text-re-search-backward ti::text-re-search-forward -;;;;;; ti::text-buffer ti::text-looking-at ti::text-re-search) "tinylibt" -;;;;;; "tinylibt.el" (15378 27672)) -;;; Generated autoloads from tinylibt.el - -(autoload (quote ti::text-re-search) "tinylibt" "\ -Highlight found text with search face. - -Note: - - The beginning of match and end of match will have - property 'rear-nonsticky t, so that adding characters before of after - text, won't inherit the face. - -Input: - - RE str regexp - DIRECTION bool non-nil means backward - LEVEL nbr which subexpression in re to highlight, default is 0 - MAXP nbr last search point [default until bob/eob] - - FACE sym face symbol - if symbol is 'null then set face to value nil - or if this is list; then it must be properly list - of format '(PROP PROP-VAL PROP PROP-VAL ..) - - MODE nbr signify that function should highlight all matches - that occur within LEVEL..NBR - if you have lot's of xx(match)yy|zz(match)tt| - the subexpression are counted from left to to - right: 1,2 ... - SAVE-UNDO flag non-nil means that the highlight information is - recorded for undo. This flag in on if function is - called interactively. NOTE: the undo information is - saved only if something was matched. - -Return: - - nil No match - nbr start of match at LEVEL." nil nil) - -(autoload (quote ti::text-looking-at) "tinylibt" "\ -Highlight found RE at LEVEL with FACE-OR-PLIST. -The LEVEL is subexpression to highlight. PLIST means property list." t nil) - -(autoload (quote ti::text-buffer) "tinylibt" "\ -Highlight RE and sub LEVEL in whole buffer, starting from `point-min'. -Preserve point. - -See `ti::text-re-search' for descriptions of FACE MODE and SAVE-UNDO." t nil) - -(autoload (quote ti::text-re-search-forward) "tinylibt" "\ -Search RE and highlight forward until `point-max'. -Optional prefix arg tells which subexpression LEVEL to match that -function should highlight. point is preserved during call. - -See `ti::text-re-search' for descriptions of FACE MODE SAVE-UNDO." t nil) - -(autoload (quote ti::text-re-search-backward) "tinylibt" "\ -Search RE and highlight backward until `point-min'. -Optional prefix arg tells which subexpression LEVEL to match that -function should highlight. point is preserved during call. - -See `ti::text-re-search' for descriptions of FACE MODE SAVE-UNDO." t nil) - -(autoload (quote ti::text-mouse-mark-region) "tinylibt" "\ -Highlight region BEG END. EVENT is mouse event." t nil) - -(autoload (quote ti::text-mouse-unmark-region) "tinylibt" "\ -Remove highlight from region BEG END. EVENT is mouse event." t nil) - -(autoload (quote ti::text-unmark-region) "tinylibt" "\ -Remove highlight from region BEG END." t nil) - -(autoload (quote ti::text-mark-region) "tinylibt" "\ -Highlight BEG END. With optional prefix arg REMOVE all matching FACE." t nil) - -;;;*** - -;;;### (autoloads nil "tinylisp" "tinylisp.el" (15407 17982)) -;;; Generated autoloads from tinylisp.el - (autoload 'tinylisp-elp-summary-mode "tinylisp" t t) - (autoload 'turn-on-tinylisp-elp-summary-mode "tinylisp" t t) - (autoload 'turn-off-tinylisp-elp-summary-mode "tinylisp" t t) - (autoload 'tinylisp-version "tinylisp" "Display commentary" t) - -;;;*** - -;;;### (autoloads (tinyload-loader-process tinyload-install) "tinyload" -;;;;;; "tinyload.el" (15378 27672)) -;;; Generated autoloads from tinyload.el - -(autoload (quote tinyload-install) "tinyload" "\ -Install package or REMOVE. -This function removes any previous TinyLoad timer process and resets -the list pointer to 0." t nil) - -(autoload (quote tinyload-loader-process) "tinyload" "\ -Load packages defined in `tinyload-:load-list'. -If called interactively, FORCE loading all packages in the list." t nil) - -;;;*** - -;;;### (autoloads (tinylock-lock tinylock-history) "tinylock" "tinylock.el" -;;;;;; (15378 27674)) -;;; Generated autoloads from tinylock.el - (autoload 'tinylock-version "tinylock" "Display commentary." t) - -(autoload (quote tinylock-history) "tinylock" "\ -Displays login history. Optionally to given buffer BUFFER." t nil) - -(autoload (quote tinylock-lock) "tinylock" "\ -Lock Emacs with PSW password and MSG. -Message is displayed if LOCK-NOW is nil. -If LOCK-NOW is non-nil emacs is immediately locked with PSW." t nil) - -;;;*** - -;;;### (autoloads (tinymacro-assign tinymacro-end-kbd-macro-and-assign) -;;;;;; "tinymacro" "tinymacro.el" (15378 27674)) -;;; Generated autoloads from tinymacro.el - (autoload 'tinymacro-version "tinymacro" "Display commentary." t) - -(autoload (quote tinymacro-end-kbd-macro-and-assign) "tinymacro" "\ -Terminate reading macro and assign it to key." t nil) - -(autoload (quote tinymacro-assign) "tinymacro" "\ -Name last macro and assigns it to user defined KEY. -Runs tinymacro-:macro-assigned-hook if key macro gets installed. -The query options should be turned off if you call this within -function, since it always return nil if the options are on. - -Input: - - KEY Should be valid emacs key-bind-sequence/key-vector - VERB Boolean, verbose messages - -Return: - - t is assigned - nil not assigned `keyboard-quit'" t nil) - -;;;*** - -;;;### (autoloads (tinymail-on-off-toggle tinymail-mail tinymail-deactivate-and-send-to-you) -;;;;;; "tinymail" "tinymail.el" (15411 20732)) -;;; Generated autoloads from tinymail.el - (autoload 'tinymail-version "tinymail" "Display commentary." t) - (autoload 'tinymail-mode "tinymail" "" t) - (autoload 'turn-on-tinymail-mode "tinymail" "" t) - (autoload 'turn-off-tinymail-mode "tinymail" "" t) - (autoload 'tinymail-commentary "tinymail" "" t) - -(autoload (quote tinymail-deactivate-and-send-to-you) "tinymail" "\ -Deactivate TIMI and change To field to point to your address. -This function is normally used when you use mailing lists. See -documentation in the tinymail.el or call \\[tinymail-version]." t nil) - -(autoload (quote tinymail-mail) "tinymail" "\ -Prepare mail mode. -Add or changes Cc, FF, X-Sender-Info fields on the fly while you're -composing the message. - -Input: - - DISABLE Disables package. - VERB print verbose message. - -References: - - `tinymail-:feature-hook'." nil nil) - -(autoload (quote tinymail-on-off-toggle) "tinymail" "\ -Toggle TIMI mode on and off by Changing spacing of To field. -This affects automatic Cc and X-Sender-Info tracking. -ARG behaves like mode argument. - -Without arg, this toggless Cc tracking, with prefix argument, -it toggless both Cc and X-Sender-Info tracking." t nil) - -;;;*** - -;;;### (autoloads (tinymailbox-message-to-file tinymailbox-message-to-folder -;;;;;; tinymailbox-copy-body tinymailbox-copy tinymailbox-delete -;;;;;; tinymailbox-begin) "tinymailbox" "tinymailbox.el" (15407 -;;;;;; 48240)) -;;; Generated autoloads from tinymailbox.el - (autoload 'tinymailbox-version "tinymailbox" "Display commentary" t) - (autoload 'tinymailbox-install-mode "tinymailbox" "" t) - (autoload 'tinymailbox-mode "tinymailbox" "" t) - (autoload 'turn-on-tinymailbox-mode "tinymailbox" "" t) - (autoload 'turn-off-tinymailbox-mode "tinymailbox" "" t) - (autoload 'tinymailbox-commentary "tinymailbox" "" t) - (autoload 'tinymailbox-forward "tinymailbox" "Go to next message." t) - (autoload 'tinymailbox-backward "tinymailbox" "Go to previous message." t) - -(autoload (quote tinymailbox-begin) "tinymailbox" "\ -Move to message begin. Optionally BACKWARD." t nil) - -(autoload (quote tinymailbox-delete) "tinymailbox" "\ -Delete current message. point must be inside message." t nil) - -(autoload (quote tinymailbox-copy) "tinymailbox" "\ -Copy current message. point must be inside message." t nil) - -(autoload (quote tinymailbox-copy-body) "tinymailbox" "\ -Copy body of current message. point must be inside message." t nil) - -(autoload (quote tinymailbox-message-to-folder) "tinymailbox" "\ -File current message by appending it to FILE." t nil) - -(autoload (quote tinymailbox-message-to-file) "tinymailbox" nil t nil) - -;;;*** - -;;;### (autoloads (tinymy-buffer-file-chmod tinymy-install tinymy-define-keys-extra -;;;;;; tinymy-define-keys) "tinymy" "tinymy.el" (15407 17982)) -;;; Generated autoloads from tinymy.el - (autoload 'tinymy-version "tinymy" "Display commentary." t) - -(autoload (quote tinymy-define-keys) "tinymy" "\ -Install keys." t nil) - -(autoload (quote tinymy-define-keys-extra) "tinymy" "\ -Define extra global keys." t nil) - (autoload 'tinymy-install-files "tinymy" "" t) - -(autoload (quote tinymy-install) "tinymy" "\ -Configures Emacs variables and bindings." t nil) - -(autoload (quote tinymy-buffer-file-chmod) "tinymy" "\ -Toggle current buffer's Read-Write permission permanently on disk. VERB. -Does nothing if buffer is not visiting a file or file is not owned by us." t nil) - -;;;*** - -;;;### (autoloads nil "tinynbr" "tinynbr.el" (15381 6616)) -;;; Generated autoloads from tinynbr.el - (autoload 'tinynbr-version "tinynbr" "Display commentary." t) - (autoload 'tinynbr-mode "tinynbr" "" t) - (autoload 'turn-on-tinynbr-mode "tinynbr" "" t) - (autoload 'tun-off-tinynbr-mode "tinynbr" "" t) - (autoload 'tinynbr-commentary "tinynbr" "" t) - (autoload 'tinynbr-int-to-hex "tinynbr" "" t) - (autoload 'tinynbr-int-to-oct "tinynbr" "" t) - (autoload 'tinynbr-int-to-bin "tinynbr" "" t) - (autoload 'tinynbr-hex-to-int "tinynbr" "" t) - (autoload 'tinynbr-oct-to-int "tinynbr" "" t) - (autoload 'tinynbr-bin-to-int "tinynbr" "" t) - -;;;*** - -;;;### (autoloads nil "tinypad" "tinypad.el" (15378 27674)) -;;; Generated autoloads from tinypad.el - (autoload 'tinypad-mode "tinypad" "" t) - (autoload 'turn-on-tinypad-mode "tinypad" "" t) - (autoload 'turn-off-tinypad-mode "tinypad" "" t) - (autoload 'tinypad-version "tinypad" "Display commentary." t) - -;;;*** - -;;;### (autoloads (tinypage-go-next tinypage-go-previous tinypage-yank-after -;;;;;; tinypage-yank-before tinypage-yank tinypage-cut tinypage-copy -;;;;;; tinypage-select tinypage-region-action) "tinypage" "tinypage.el" -;;;;;; (15378 27674)) -;;; Generated autoloads from tinypage.el - (autoload 'tinypage-version "tinypage" "Display commentary." t) - (autoload 'tinypage-mode "tinypage" "" t) - (autoload 'turn-on-tinypage-mode "tinypage" "" t) - (autoload 'turn-off-tinypage-mode "tinypage" "" t) - (autoload 'tinypage-commentary "tinypage" "" t) - -(autoload (quote tinypage-region-action) "tinypage" "\ -Execute action ACT. Return t or nil. VERB." nil nil) - -(autoload (quote tinypage-select) "tinypage" "\ -Select page. If sitting on page Marker, use page below. VERB." t nil) - -(autoload (quote tinypage-copy) "tinypage" "\ -Select page. If sitting on page Marker, use page below. VERB." t nil) - -(autoload (quote tinypage-cut) "tinypage" "\ -Select page. If sitting on page Marker, use page below. VERB." t nil) - -(autoload (quote tinypage-yank) "tinypage" "\ -Yank page from register. VERB." t nil) - -(autoload (quote tinypage-yank-before) "tinypage" "\ -Yank page from register, but _before_ current page. VERB." t nil) - -(autoload (quote tinypage-yank-after) "tinypage" "\ -Yank page from register, but _after_ current page. -Optionally BEFORE with MSG and VERB." t nil) - -(autoload (quote tinypage-go-previous) "tinypage" "\ -Go to previous page. VERB." t nil) - -(autoload (quote tinypage-go-next) "tinypage" "\ -Go to next page, optionally BACK. Return point if moved. VERB." t nil) - -;;;*** - -;;;### (autoloads nil "tinypair" "tinypair.el" (15384 58070)) -;;; Generated autoloads from tinypair.el - (autoload 'tinypair-version "tinypair" "Display commentary." t) - (autoload 'tinypair-mode "tinypair" "" t) - (autoload 'turn-on-tinypair-mode "tinypair" "" t) - (autoload 'turn-off-tinypair-mode "tinypair" "" t) - (autoload 'tinypair-commentary "tinypair" "" t) - -;;;*** - -;;;### (autoloads (tinypath-report-mode) "tinypath" "tinypath.el" -;;;;;; (15407 48240)) -;;; Generated autoloads from tinypath.el - -(autoload (quote tinypath-report-mode) "tinypath" "\ -Major mode to help working with `tinypath-cache-duplicate-report'. VERB. - -\\{tinypath-report-mode-map}" t nil) - -;;;*** - -;;;### (autoloads (tinyperl-pod-grep-and-make-faq-answer tinyperl-pod-grep -;;;;;; tinyperl-pod-by-manpage tinyperl-pod-find-file tinyperl-pod-by-module -;;;;;; tinyperl-module-find-file tinyperl-perldoc tinyperl-pod-kill-buffers -;;;;;; turn-on-tinyperl-mode-all-buffers tinyperl-install) "tinyperl" -;;;;;; "tinyperl.el" (15407 48240)) -;;; Generated autoloads from tinyperl.el - (autoload 'tinyperl-version "tinyperl" "Display commentary." t) - -(autoload (quote tinyperl-install) "tinyperl" "\ -Install tinyperl. - -Input: - - FORCE If non-nil, rebuild all variables and - save new `(tinyperl-cache-file-name)'. - If nil, read saved variables from `(tinyperl-cache-file-name)'. - - VERB Allow verbose messaegs." t nil) - -(autoload (quote turn-on-tinyperl-mode-all-buffers) "tinyperl" "\ -Turn function `tinyperl-mode' on in every perl buffer. Optionally turn OFF." t nil) - (autoload 'tinyperl-mode "tinyperl" "" t) - (autoload 'turn-on-tinyperl-mode "tinyperl" "" t) - (autoload 'turn-off-tinyperl-mode "tinyperl" "" t) - (autoload 'tinyperl-commentary "tinyperl" "" t) - (autoload 'tinyperl-pod-view-mode "tinyperl" "" t) - (autoload 'turn-on-tinyperl-pod-view-mode "tinyperl" "" t) - (autoload 'turn-off-tinyperl-pod-view-mode "tinyperl" "" t) - (autoload 'tinyperl-pod-write-mode "tinyperl" "" t) - (autoload 'turn-on-tinyperl-pod-write-mode "tinyperl" "" t) - (autoload 'turn-off-tinyperl-pod-write-mode "tinyperl" "" t) - -(autoload (quote tinyperl-pod-kill-buffers) "tinyperl" "\ -Kill all temporary POD buffers." t nil) - -(autoload (quote tinyperl-perldoc) "tinyperl" "\ -Run perldoc with STRING. First try with -f then without it. -Show content in `tinyperl-:perldoc-buffer'. If buffer is visible in -some other frame, the cursor is not moved there. Only contents is updated. - -The last used STRING is cached and if called next time with same -string, the shell command is not called unless FORCE is non-nil. - -Input: - - STRING Seach string - FORCE Force calling shell although answer cached - VERB flag, Allow verbose messages - -References: - - `tinyperl-:perldoc-hook'" t nil) - -(autoload (quote tinyperl-module-find-file) "tinyperl" "\ -Load Perl MODULE source." t nil) - -(autoload (quote tinyperl-pod-by-module) "tinyperl" "\ -Show pod manual page for MODULE or load MODULE. - -Input: - - MODULE The Perl module as it appears in `use' statement, - like Getopt::Long the '.pm' is automatically added. - MODE If non-nil, load source file, not pod." t nil) - -(autoload (quote tinyperl-pod-find-file) "tinyperl" "\ -Run pod2text on FILE and create new buffer: '*pod' + FILE + '*'. -If file contains pod documentation section, it will be formatted nicely." t nil) - -(autoload (quote tinyperl-pod-by-manpage) "tinyperl" "\ -Display pod for FILE." t nil) - -(autoload (quote tinyperl-pod-grep) "tinyperl" "\ -Grep REGEXP from perl pod files. -This is your way to find what pages contain references to the items you're -looking for. However if you select the file from compile buffer, it is -in the unconverted format (.pod). A better would be to momorize the -pod file name, like - - perlre.pod:165: \\Z Match at only e - -And call immediately \\[tinyperl-pod-by-manpage] and view `perlre' in -more pleasant manner. Few C-s searches or \\[occur] will take you -to the correct position." t nil) - -(autoload (quote tinyperl-pod-grep-and-make-faq-answer) "tinyperl" "\ -Grep REGEXP from perl pod files. - -This function also gathers all =head topics that match the REGEXP. -You can use generated page as an answer to 'Has this this question -been answered in FAQ'" t nil) - -;;;*** - -;;;### (autoloads (tinypgp-hide-show-toggle tinypgp-xpgp-header-toggle -;;;;;; tinypgp-xpgp-header-mode-toggle tinypgp-crypt-region tinypgp-crypt-mail -;;;;;; tinypgp-decrypt-region tinypgp-decrypt-mail tinypgp-encrypt-region -;;;;;; tinypgp-encrypt-region-sign tinypgp-encrypt-mail tinypgp-encrypt-mail-sign -;;;;;; tinypgp-sign-region tinypgp-sign-mail tinypgp-sign-loose-info -;;;;;; tinypgp-sign-mail-auto-mode) "tinypgp" "tinypgp.el" (15411 -;;;;;; 18642)) -;;; Generated autoloads from tinypgp.el - (autoload 'tinypgp-newnym-req-acksend "tinypgp" "" t) - (autoload 'tinypgp-newnym-req-sigsend "tinypgp" "" t) - (autoload 'tinypgp-newnym-req-cryptrecv "tinypgp" "" t) - (autoload 'tinypgp-newnym-req-fixedsize "tinypgp" "" t) - (autoload 'tinypgp-newnym-req-disable "tinypgp" "" t) - (autoload 'tinypgp-newnym-req-fingerkey "tinypgp" "" t) - (autoload 'tinypgp-newnym-req-nobcc "tinypgp" "" t) - -(autoload (quote tinypgp-sign-mail-auto-mode) "tinypgp" "\ -Toggle autosigning mode according to ARG. - -Input: - 0, -1 off - nil toggle - t, 1 on - - 'push-on Record previous value and turn on auto signing. - 'push-off Record previous value and turn off auto signing. - 'pop pop previous autosign value. - -Return: - nil autosigning off - non-nil autosigning on" t nil) - -(autoload (quote tinypgp-sign-loose-info) "tinypgp" "\ -Loose signature info. -Input: - VERB Verbose messages." t nil) - -(autoload (quote tinypgp-sign-mail) "tinypgp" "\ -Sign message in mail buffer. - -Input: - - REGISTER flag, if non-bil store the signature to register. - This is the prefix arg user passes to program. - This will automatically turn off X-pgp. - USER key-id - VERB allow verbose messages - NOXPGP Prohibit X-Pgp - -Notes: - - if VERB is non-nil (set in interactive call), the pubring is - changed if it the information is on the cache." t nil) - -(autoload (quote tinypgp-sign-region) "tinypgp" "\ -Sign region. - -Input: - - BEG END ints, region - VERB flag, verbose messages - OPTIONS string, flags to add to the real pgp command. - NOERR flag, return nil or t only - REGISTER flag, save results to register - AS-IS flag, if non-nil. no buffer modification is done. - Normally would delete whitespaces at the end of lines. -" t nil) - -(autoload (quote tinypgp-encrypt-mail-sign) "tinypgp" "\ -See `tinypgp-encrypt-mail'. Raise parameter 'sign'. -SINGLE-OR-LIST NO-REPLACE SIGN-PWD OPTIONS VERB NOERR." t nil) - -(autoload (quote tinypgp-encrypt-mail) "tinypgp" "\ -Encrypt mail buffer. - -Input: - - SINGLE-OR-LIST List of key-ids. Interactive call reads To,CC,BCC. - NO-REPLACE prefix arg, store result to `tinypgp-:register'. - SIGN-FLAG if non-nil, sign at the same time as you encrypt. - OPTIONS Additional pgp option string. - VERB If non-nil, verbose messages. - NOERR If non-nil, do not call error. - -Function call note: - - [interactive] - In case the EMAIL address you're sending doesn't have entry in your - keyring, but you know that person has a PGP public key, then - please remove the email address prior calling this function and - it will prompt you a string to match for USER. - - If this function is called interactively, it tries to set right - pubring by querying cache and other keyrings (user prompted) - Also the `tinypgp-:pgp-exe-interactive-option' is suppressed if - `tinypgp-:r-mode-indication-flag' is non-nil - - Normally the To field's address is read and used for encryption. - However, if you are _on_ line that has email address in format - then your are asked if you want to use this email - instead. You can complete between this and To address. - - [when called as lisp function] - Be sure to take precaution when passing OPTIONS if the message is - sent to remailer. Any extra keyword, like 'Comment:' - may reveal your identity. - - SINGLE-OR-LIST is not processed with `tinypgp-key-id-conversion'. - You should call it manually if you want to respect user's - substitution definitions. - - [Genenal note] - If there are multiple recipiens in the To, CC, BCC field the - last keyring in the `tinypgp-pubring-table' is used when doing the - encryption. - -Input: - - single-or-list list of email addresses or KEY ID's - no-replace flag, do not replace area with encryption - options string, extra options passed to pgp exe - verb flag, allow printing messages." t nil) - -(autoload (quote tinypgp-encrypt-region-sign) "tinypgp" "\ -Same as `tinypgp-encrypt-region' but raise 'sign' parameter. -BEG END USER NO-REPLACE SIGN-PWD OPTIONS VERB" t nil) - -(autoload (quote tinypgp-encrypt-region) "tinypgp" "\ -Encrypt region. - -Input: - - BEG END region - USER key-id (possibly email) or list of keyIds. - NO-REPLACE prefix arg, store results to `tinypgp-:register' - SIGN-PWD if non-nil string, Sign at the same time as you encrypt. - OPTIONS Additional option string for PGP. - VERB If non-nil, Verbose messages." t nil) - -(autoload (quote tinypgp-decrypt-mail) "tinypgp" "\ -Decrypt mail buffer. -The PGP data in the buffer is detected by reading the CTB bits: -see pgpformat.doc in pgp documentation. - -Input: - - NO-REPLACE flag, prefix arg instructs to show the cotent in - separate buffer. See refrerence note too. - If this is 'preview and verb argument is nil-nil, - then automatically show content is different buffer. - - TYPE nil or \"pgp\" --> PGP encrypted - \"base64\" --> base64 signed and - \"conventional\" --> encrypted with conventional key. - - VERB Verbose mode. - -References: - - `tinypgp-:pgp-encrypted-p-function' - `tinypgp-:decrypt-arg-interpretation' for interactive calls - `tinypgp-:pgp-decrypt-arg-function' for interactive calls - `tinypgp-:user-identity-table'" t nil) - -(autoload (quote tinypgp-decrypt-region) "tinypgp" "\ -Decrypt region. Signal error is there is no decrypt message. - -Input: - - BEG END int, region - NO-REPLACE flag, store contents to `tinypgp-:register'. - If values is 'review and verb is non-nil, also display - content in separate buffer. Calls `tinypgp-view-register' - TYPE string, Decrypt type: conventional, base64 or pgp - VERB flag, verbose messages" t nil) - -(autoload (quote tinypgp-crypt-mail) "tinypgp" "\ -Crypt mail buffer. - -Input: - - PASSWORD pass phrase - NO-REPLACE store contents to `tinypgp-:register'. - COMMENT Additional comment added - VERB verbose messages" t nil) - -(autoload (quote tinypgp-crypt-region) "tinypgp" "\ -Crypt region. - -Input: - - BEG END region - PASSWORD pass phrase - NO-REPLACE store contents to `tinypgp-:register'. - COMMENT The comment string. - VERB verbose messages" t nil) - -(autoload (quote tinypgp-xpgp-header-mode-toggle) "tinypgp" "\ -Toggle X-pgp header mode with ARG. - -References - `tinypgp-:header-sign-table' ,this variable overrides the signing mode." t nil) - -(autoload (quote tinypgp-xpgp-header-toggle) "tinypgp" "\ -Togle moving signature FROM/TO headers." t nil) - -(autoload (quote tinypgp-hide-show-toggle) "tinypgp" "\ -Togle hiding and showing the PGP signature." t nil) - -;;;*** - -;;;### (autoloads (turn-on-tinyprocmail-mode-all-buffers turn-off-tinyprocmail-mode-all-buffers) -;;;;;; "tinyprocmail" "tinyprocmail.el" (15378 27674)) -;;; Generated autoloads from tinyprocmail.el - (autoload 'tinyprocmail-mode "tinyprocmail" "" t) - (autoload 'turn-on-tinyprocmail-mode "tinyprocmail" "" t) - (autoload 'turn-off-tinyprocmail-mode "tinyprocmail" "" t) - (autoload 'tinyprocmail-commentary "tinyprocmail" "" t) - (autoload 'tinyprocmail-version "tinyprocmail" "" t) - (autoload 'tinyprocmail-output-mode "tinyprocmail" "" t) - (autoload 'turn-on-tinyprocmail-output-mode "tinyprocmail" "" t) - (autoload 'turn-off-tinyprocmail-output-mode "tinyprocmail" "" t) - (autoload 'tinyprocmail-install-files "tinyprocmail" t t) - -(autoload (quote turn-off-tinyprocmail-mode-all-buffers) "tinyprocmail" "\ -Call `turn-on-tinyprocmail-mode-all-buffers' with parameter `off'. VERB." t nil) - -(autoload (quote turn-on-tinyprocmail-mode-all-buffers) "tinyprocmail" "\ -Turn on or OFF function `tinyprocmail-mode' for all procmail buffers. VERB. -Procmail files start with `rc.' or end to `.rc' and file content -must match `^:0'." t nil) - -;;;*** - -;;;### (autoloads (tinyreplace-latex-math-replace tinyreplace-latex-blk-replace -;;;;;; tinyreplace-replace-forward tinyreplace-replace-region tinyreplace-replace-over-files-compile-buffer -;;;;;; tinyreplace-symmetry-toggle tinyreplace-define-keys-compile-map -;;;;;; tinyreplace-menu) "tinyreplace" "tinyreplace.el" (15382 22904)) -;;; Generated autoloads from tinyreplace.el - -(autoload (quote tinyreplace-menu) "tinyreplace" "\ -Run `tinyreplace-:menu'." t nil) - -(autoload (quote tinyreplace-define-keys-compile-map) "tinyreplace" "\ -Define key bindings." t nil) - -(autoload (quote tinyreplace-symmetry-toggle) "tinyreplace" "\ -Toggle variable` tinyreplace-:symmetry' with ARG. VERB." t nil) - -(autoload (quote tinyreplace-replace-over-files-compile-buffer) "tinyreplace" "\ -Read all files forward in buffer that is in compile buffer format. -Perform replace over the found files. Checks Out files that are -RCS controlled if necessary. - -Line format: - - /DIR/DIR/FILE: matched text - -Input: - - See function `tinyreplace-replace-1' - BEG END STR1 STR2 &OPTIONAL FUNC VERB" t nil) - -(autoload (quote tinyreplace-replace-region) "tinyreplace" "\ -In region BEG END, find STR1 and replace with STR2." t nil) - -(autoload (quote tinyreplace-replace-forward) "tinyreplace" "\ -Find STR1 and replace with STR2 from current point forward. -See source code of function `tinyreplace-args-keymap-create' what key bindings -you can use. Normally C - l yanks, and \"\\\" key deletes line." t nil) - -(autoload (quote tinyreplace-latex-blk-replace) "tinyreplace" "\ -Select latex block areas for replace. - -Input: - - STR1 STR2 Find and replace with. - BLK Block delimiter to find - BEG-RE END-RE Region bound regexps." t nil) - -(autoload (quote tinyreplace-latex-math-replace) "tinyreplace" "\ -Find STR1 and replace with STR2 inside latex math blocks." t nil) - -;;;*** - -;;;### (autoloads (tinyrmail-rmail-summary-by-labels-and) "tinyrmail" -;;;;;; "tinyrmail.el" (15378 27676)) -;;; Generated autoloads from tinyrmail.el - (autoload 'tinyrmail-version "tinyrmail" "Display commentary." t) - (autoload 'tinyrmail-install-files "tinyrmail" t t) - -(autoload (quote tinyrmail-rmail-summary-by-labels-and) "tinyrmail" "\ -Display a summary of all messages with one or more LABELS. -LABELS should be a string containing the desired labels, separated by commas. -This summary is prduced by _ANDING_ the labels." t nil) - -;;;*** - -;;;### (autoloads (tinyscroll-control tinyscroll-list tinyscroll-timer-process-control) -;;;;;; "tinyscroll" "tinyscroll.el" (15411 18598)) -;;; Generated autoloads from tinyscroll.el - (autoload 'tinyscroll-version "tinyscroll" "Commentary." t) - -(autoload (quote tinyscroll-timer-process-control) "tinyscroll" "\ -Keep the auto scroll process and timer process alive. -Optionally DELETE auto scroll process. VERB." t nil) - -(autoload (quote tinyscroll-list) "tinyscroll" "\ -Show list of active auto scroll buffers. -Buffers are listed inecho-area if they fit there, otherwise in separate buffer. - -If optional PRINT flag is non-nil, always generate report to temporary buffer. -If list if empty, do nothing. - -Return: - - t report generated to temporary buffer - nil no report" t nil) - -(autoload (quote tinyscroll-control) "tinyscroll" "\ -Turn on auto scroll on/off for current buffer. -If this command is called from `tinyscroll-:tmp-buffer' then the current -word in the line is read and offered for default buffer name. - -Input: - - BUFFER-OR-POINTER buffer to scroll - OFF flag, prefix arg; is non-nil turn scrolling off - VERB flag, allow verbose messages." t nil) - -;;;*** - -;;;### (autoloads (tinysearch-search-word-backward tinysearch-search-word-forward -;;;;;; ) "tinysearch" "tinysearch.el" -;;;;;; (15382 30960)) -;;; Generated autoloads from tinysearch.el - -(autoload (quote tinysearch-search-word-forward) "tinysearch" "\ -Search word at point forward." t nil) - -(autoload (quote tinysearch-search-word-backward) "tinysearch" "\ -Search word at point backward." t nil) - -;;;*** - -;;;### (autoloads (tinytab-return-key-mode tinytab-tab-del-key tinytab-tab-key) -;;;;;; "tinytab" "tinytab.el" (15378 27676)) -;;; Generated autoloads from tinytab.el - (autoload 'tinytab-mode "tinytab" "" t) - (autoload 'turn-on-tinytab-mode "tinytab" "" t) - (autoload 'turn-off-tinytab-mode "tinytab" "" t) - (autoload 'tinytab-commentary "tinytab" "" t) - (autoload 'tinytab-version "tinytab" "" t) - -(autoload (quote tinytab-tab-key) "tinytab" "\ -Main function for TAB key. See variable `tinytab-:tab-insert-hook'." t nil) - -(autoload (quote tinytab-tab-del-key) "tinytab" "\ -Main function for TAB key. See variable `tinytab-:tab-delete-hook'." t nil) - -(autoload (quote tinytab-return-key-mode) "tinytab" "\ -Toggle auto indent MODE / regular newline mode. VERB." t nil) - -;;;*** - -;;;### (autoloads (tinytag-post-command tinytag-main-mouse tinytag-main -;;;;;; tinytag-install-sample-database-c tinytag-install-sample-database-java -;;;;;; tinytag-install) "tinytag" "tinytag.el" (15411 18378)) -;;; Generated autoloads from tinytag.el - -(autoload (quote tinytag-install) "tinytag" "\ -Install package. Optionally UNINSTALL." t nil) - -(autoload (quote tinytag-install-sample-database-java) "tinytag" "\ -Install Java database from Sub JDK documentation." t nil) - -(autoload (quote tinytag-install-sample-database-c) "tinytag" "\ -Install c/C++ database from file tintytag.el." t nil) - -(autoload (quote tinytag-main) "tinytag" "\ -Run `tinytag-:try-hook' until some of the functions return non-nil." t nil) - -(autoload (quote tinytag-main-mouse) "tinytag" "\ -See `tinytag-main'. Function is called with mouse EVENT." t nil) - -(autoload (quote tinytag-post-command) "tinytag" "\ -Activates only if `tinytag-:set-database-hook' wakes up. -Show the database definition for the current word under point. - -References: - - `tinytag-:noerror' - `tinytag-:post-command-hook-wakeup' - `tinytag-:set-database-hook'" nil nil) - -;;;*** - -;;;### (autoloads (turn-on-tinytf-mode-maybe tinytf-mode-define-f-keys) -;;;;;; "tinytf" "tinytf.el" (15411 20766)) -;;; Generated autoloads from tinytf.el - (autoload 'tinytf-version "tinytf" "Display commentary." t) - (autoload 'tinytf-install-mode "tinytf" "" t) - (autoload 'tinytf-mode "tinytf" "" t) - (autoload 'turn-on-tinytf-mode "tinytf" "" t) - (autoload 'turn-off-tinytf-mode "tinytf" "" t) - (autoload 'tinytf-commentary "tinytf" "" t) - -(autoload (quote tinytf-mode-define-f-keys) "tinytf" "\ -Define default F key to `tinytf-:mode-map'." t nil) - (autoload 'tinytf-install-files "tinytf" t t) - -(autoload (quote turn-on-tinytf-mode-maybe) "tinytf" "\ -Turn on mode function `tinytf-mode' if TOC entry is found." nil nil) - -;;;*** - -;;;### (autoloads (tinyurl-install tinyurl-mode-1 turn-on-tinyurl-mode-mail -;;;;;; turn-on-tinyurl-mode-1-maybe turn-on-turn-off-tinyurl-mode-1-maybe) -;;;;;; "tinyurl" "tinyurl.el" (15380 59900)) -;;; Generated autoloads from tinyurl.el - (autoload 'tinyurl-version "tinyurl" "Display commentary." t) - (autoload 'tinyurl-debug-toggle "tinyurl" "" t) - (autoload 'tinyurl-mode "tinyurl" "" t) - (autoload 'turn-on-tinyurl-mode "tinyurl" "" t) - (autoload 'turn-off-tinyurl-mode "tinyurl" "" t) - (autoload 'tinyurl-commentary "tinyurl" "" t) - -(autoload (quote turn-on-turn-off-tinyurl-mode-1-maybe) "tinyurl" "\ -Activate or Deactivate `tinyurl-mode-1' in current buffer. -Try to find ftp, http or email is found. -The value of `tinyurl-:exclude-function' is consulted first." nil nil) - -(autoload (quote turn-on-tinyurl-mode-1-maybe) "tinyurl" "\ -Activate `tinyurl-mode-1' in current buffer if ftp, http or email is found. -This function is meant to be used in eg. Article display -hooks in Mail Agents. - -References: - - The value of `tinyurl-:exclude-function' is consulted first." nil nil) - -(autoload (quote turn-on-tinyurl-mode-mail) "tinyurl" "\ -Turn on `tinyurl-mode-1' and make `tinyurl-:mouse-yank-at-point' local." nil nil) - -(autoload (quote tinyurl-mode-1) "tinyurl" "\ -Turn mode on or off with mode ARG for current buffer only. -If you want to turn on or off globally, use function `tinyurl-mode'." t nil) - -(autoload (quote tinyurl-install) "tinyurl" "\ -Install or `UNINSTALL package." t nil) - -;;;*** - -;;;### (autoloads nil "tinyvc" "tinyvc.el" (15378 27676)) -;;; Generated autoloads from tinyvc.el - (autoload 'tinyvc-mode "tinyvc" "" t) - (autoload 'turn-on-tinyvc-mode "tinyvc" "" t) - (autoload 'turn-off-tinyvc-mode "tinyvc" "" t) - (autoload 'tinyvc-commentary "tinyvc" "" t) - (autoload 'tinyvc-version "tinyvc" "" t) - -;;;*** - -;;;### (autoloads (tinyxreg-jump-to-register-mouse tinyxreg-jump-to-register -;;;;;; tinyxreg-remove-register tinyxreg-point-to-register tinyxreg-point-to-register-mouse -;;;;;; tinyxreg-trash tinyxreg-remove-reg) "tinyxreg" "tinyxreg.el" -;;;;;; (15378 27676)) -;;; Generated autoloads from tinyxreg.el - (autoload 'tinyxreg-version "tinyxreg" "Display commentary." t) - -(autoload (quote tinyxreg-remove-reg) "tinyxreg" "\ -Remove register CHAR from stored window and point lists. -ARG suggests looking in window list." t nil) - -(autoload (quote tinyxreg-trash) "tinyxreg" "\ -Empties both window and point caches." t nil) - -(autoload (quote tinyxreg-point-to-register-mouse) "tinyxreg" "\ -Call `tinyxreg-point-to-register' using mouse EVENT." t nil) - -(autoload (quote tinyxreg-point-to-register) "tinyxreg" "\ -Store point to CHAR and to X-popup list. -With prefix ARG, store current frame configuration. VERBOSE enables -message printing. - -Use \\[tinyxreg-point-to-register] to go to that location or restore the -configuration." t nil) - -(autoload (quote tinyxreg-remove-register) "tinyxreg" "\ -Remove register from popup list. -See `tinyxreg-jump-to-register-mouse' for more." t nil) - -(autoload (quote tinyxreg-jump-to-register) "tinyxreg" "\ -Call `tinyxreg-jump-to-register-mouse' with REMOVE." t nil) - -(autoload (quote tinyxreg-jump-to-register-mouse) "tinyxreg" "\ -Displays list of registers using mouse EVENT. -Restore register or optionally REMOVE register from X-list. -Input: - - EVENT mouse event - REMOVE flag, if non-nil, remove register. - VERB flag, Allow verbose messages." t nil) - -;;;*** diff --git a/emacs_el/tiny-tools/tiny/tiny-setup.el b/emacs_el/tiny-tools/tiny/tiny-setup.el deleted file mode 100644 index dae1ec1..0000000 --- a/emacs_el/tiny-tools/tiny/tiny-setup.el +++ /dev/null @@ -1,2204 +0,0 @@ -;;; tiny-setup.el --- Tiny Tools configure center. - -;; This file is not part of Emacs - -;;{{{ Id - -;; Copyright (C) 2001-2007 Jari Aalto -;; Keywords: extensions -;; Author: Jari Aalto -;; Maintainer: Jari Aalto - -;; Look at the code with folding.el - -;; COPYRIGHT NOTICE -;; -;; This program is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by the Free -;; Software Foundation; either version 2 of the License, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -;; for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with program; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. -;; -;; Visit for more information - -;;}}} -;;{{{ Install - -;; Nothing to install. Load this file. - -;;}}} - -;;{{{ Documentation - -;;; Commentary: - -;; Preface, overview of options -;; -;; This file will configure all Tiny Tool files. The alternative method -;; is to look into each package individually and to follow instructions -;; there to set up the files. -;; -;; To use this file, see control function `tinypath-setup' for -;; full description. Try this: -;; -;; M-x RET load-library RET tiny-setup RET -;; C-h f tinypath-setup -;; M-x tinypath-setup-display -;; -;; M-x tiny-setup RET Default 'all setup -;; -;; To setup all tools from $HOME/.emacs, use: -;; -;; (load "~/path/to/tinypath.el") ;; Emacs autosetup, SEE THIS! -;; (require 'tiny-setup) ;; control center -;; (tiny-setup 'all) ;; configure all at once. -;; -;; To activate individual features: -;; -;; (tiny-setup nil '(tinymy--defadvice)) ;; Add smart M-x compile -;; -;; After you have loaded this file, have a look at the *Messages* -;, (Emacs) or *Message-Log* (XEmcs) buffers, where you can find -;; messgaes from the setup procedure. -;; -;; Emacs 21.x news: Windowed Emacs modeline contains new feature, -;; where you can activate and deactivate minor modes. Shoot -;; modeline with your mouse and follow message: "Mouse-3: minor -;; mode menu". Minor modes available here are installed to that menu. -;; -;; Administration -;; -;; This part should concern the maintainer only. -;; -;; Autoload files -;; -;; If *loaddef* files were not included in the package or if they were -;; mistakenly deleted. The tiny-setup.el startup is not possible -;; without the autoload files. -;; -;; To generate autoloads recursively, call function -;; `tiny-setup-autoload-batch-update' with the ROOT -;; directory of your lisp files. The only requirement is that each -;; directory name is unique, because the generated autoload file name -;; contains directory name: *tiny-autoload-loaddefs-DIRNAME.el* -;; -;; Compilation check -;; -;; To check for possible leaks in code, ran the byte compilation -;; function from shell by using XEmacs compiler. The Emacs byte -;; compiler is not that good in findings all errors. -;; See function `tiny-setup-compile-kit-all'. -;; -;; Profiling -;; -;; To check how much time each file load would take, see function -;; `tiny-setup-test-load-time-libraries'. Here are results as of -;; 2001-03-18 running Win9x/512Meg/400Mhz, Emacs 20.7, non-compiled -;; files: -;; -;; Timing tinyliba, took 2.025000 secs (autoloads) -;; Timing tinylibb, took 0.011000 secs -;; Timing tinylibm, took 0.977000 secs -;; Timing tinylib, took 0.982000 secs -;; Timing tinylibxe, took 0.000000 secs -;; Timing tinylibid, took 0.006000 secs -;; Timing tinylibo, took 0.005000 secs -;; Timing tinylibt, took 0.011000 secs -;; total time is 4.027999997138977 seconds - -;;}}} - -;;; Change Log: - -;;; Code: - -(eval-when-compile - (require 'cl)) - -(require 'tinyliba) - -(eval-and-compile - (defvar font-lock-mode) - (defvar mode-line-mode-menu) ;; Emacs only - (autoload 'tinydebian-install "tinydebian" "" t) - (autoload 'tinydesk-edit-state-file "tinydesk" "" t) - (autoload 'tinydesk-unload "tinydesk" "" t) - (autoload 'tinydesk-save-state "tinydesk" "" t) - (autoload 'tinydesk-recover-state "tinydesk" "" t) - (autoload 'byte-compile-file "bytecomp") - (autoload 'tinylisp-install "tinylisp" "" t) - (autoload 'turn-on-tinylisp-mode "tinylisp" "" t) - (autoload 'ti::mail-mailbox-p "tinylibmail") - (autoload 'turn-on-tinymailbox-mode "tinymailbox" "" t) - (autoload 'turn-on-tinymailbox-mode-maybe "tinymailbox" "" t) - (autoload 'folding-uninstall "folding" "" t) - (autoload 'folding-install-hooks "folding") - (autoload 'turn-on-folding-mode "folding" "" t) - (autoload 'dired-sort-default-keys "dired-sort") - (autoload 'tinymy-define-keys-extra "tinymy") - (autoload 'tinymy-compile-run-command-advice "tinymy" "" t) - (autoload 'tinymy-define-keys "tinymy") - (autoload 'tinyef-minibuffer-define-key-extras "tinyef" "" t) - (autoload 'turn-on-tinyef-mode "tinyef" "" t) - (autoload 'turn-on-tinypair-mode "tinypair" "" t) - (autoload 'turn-off-tinypair-mode "tinypair" "" t) - (autoload 'turn-on-tinyperl-mode-all-buffers "tinyperl" "" t) - (autoload 'tinyrmail-install "tinyrmail" "" t) - (autoload 'turn-on-tinycompile-mode "tinycompile" "" t) - (autoload 'tinytag-install-sample-databases "tinytag" "" t) - (autoload 'turn-on-tinytf-mode "tinytf" "" t) - (autoload 'turn-on-tinyurl-mode "tinyurl" "" t)) - -;; Copy from tinylib.el -(defmacro tiny-setup-ti::macrov-mode-line-mode-menu (mode-symbol text) - "Add MODE-SYMBOL to minor mode list in Emacs mode line menu." - (let ((sym (vector (intern (symbol-name (` (, mode-symbol))))))) - (` (when (boundp 'mode-line-mode-menu) ;; Emacs 21.1 - (define-key mode-line-mode-menu (, sym) - '(menu-item (, text) - (, mode-symbol) - :button (:toggle . (, mode-symbol)))))))) - -(defvar tiny-setup-load-hook nil - "*Hook run when package is loaded.") - -(defconst tiny-setup-:library-compile-order - '("tinylibenv.el" - "tinyliba.el" - "tinylibm.el" - "tinylibb.el") - "Order of compilation of the libraries. -This variable is list of REGEXPS.") - -(defconst tiny-setup-:library-compile-exclude - '("tinylib-ad.el") ;; adviced functions - "Libraries not to compile.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; -;; SETUP CHOICES -;; -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; See list of file descriptions with this bash script: -;; -;; head -1 $(ls *el | sort) | grep ';;' - -(defconst tiny-setup-:option-table - '(("dired-sort" - ("Dired sort package. Defines `s' key prefix to dired.") - ("autoload")) - - ("folding" - ("Folding content management package. Detect {{{ and }}}.") - ("autoload")) - - ("tinyadvice" - "Collection of advised functions." - ("load")) - - ("tinyappend" - "A simple text gathering to buffer utility." - ("bind" "bindforce")) - - ("tinybookmark" - "Keep file in organized sections." - ("bind")) - - ("tinybuffer" - "Change buffers in current window." - ("bind" "bindforce")) - - ("tinycache" - "Maintain a cache of visited files [compile, dired]." - ()) - - ("tinychist" - "Command history save/restore utility." - ()) - - ("tinycygwin" - "Cygwin bug reporting interface and other Cygwin utilities." - ()) ;;#todo: - - ("tinycomment" - "Smart comment setting utility." - ("autoload" "bind")) - - ("tinycompile" - "Compile buffer additions. Minor mode." - ("autoload")) - - ("tinydesk" - "Save and restore files between Emacs sessions." - ("activate" "bind" "bindforce")) - - ("tinydiff" - "Diff and patch minor mode. Browsing, patching." - ("autoload" "bind" "bindforce")) - - ("tinydebian" - "Debian Linux utilities for system administrator. Bug reports etc." - ("autoload" "load")) - - ("tinydired" - "Dired enhancements. Background Ange ftp support." - ("autoload")) - - ("tinyeat" - "Eat blocks of text at point, forward and backward." - ("bind" "bindforce")) - - ("tinyef" - "(E)lectric (f)ile minor mode. Easy C-x C-f filename composing." - ("autoload" "bindextra")) - - ("tinygnus" - "Gnus Plug-in. Additional functions. Spam complain and more." - ("autoload")) - - ("tinyhotlist" - "Hot-list of important buffers and files. Entry can be ange-ftp or dired too." - ("autoload" "bind" "bindforce" "bindmouse" "bindmouseforce")) - - ("tinyigrep" - "Top level interface to igrep.el." - ("autoload" "bind" "bindforce")) - - ;; there is nothing to setup in libraries. These are already - ;; autoloaded in tinyliba.el - - ("tinylib-ad" - "Library of advised functions. Backward compatibility." - ()) - ("tinylib" - "Library of general functions." - ()) - ("tinyliba" - "Library for (a)utoload definitions." - ()) - ("tinylibb" - "Library of (b)ackward compatible functions." - ()) - ("tinylibck" - "Library to (c)onvert (k)eybindings for XEmacs or Emacs." - ()) - ("tinylibenv" - "Library for environment check functions." - ()) - ("tinylibid" - "Library for (Id)entifying buffer, regardless of mode." - ()) - ("tinylibm" - "Library of s(m)all macros or functions." - ()) - ("tinylibmenu" - "Library for echo-area menu." - ()) - ("tinylibmail" - "Library of (m)ail and news (t)ool functions." - ()) - ("tinylibo" - "Library for handling (o)verlays." - ()) - ("tinylibt" - "Library for handling text properties." - ()) - ("tinylibxe" - "Library for Emacs and XEmacs emulation." - ()) - ("tinyliby" - "Library of functions related to Emacs s(y)stem." - ("defalias")) - - ("tinylisp" - "Emacs lisp programming help grab-bag." - ("autoload" "activate")) - - ("tinyload" - "Load set of packages when Emacs is idle (lazy load)." - ()) - - ;; This asks lock password at startup, can't define "load" option - ;; for this for unattended load. - - ("tinylock" - "Simple Emacs locking utility." - ()) ;;#todo: - - ("tinylpr" - "Easy Emacs lpr command handling, pop-up, completions." - ("bind")) - - ("tinymacro" - "Fast way to assign newly created macro to a key. Redefines C-x )" - ("bind" "bindforce")) - - ("tinymail" - "Mail add-ons. Report incoming mail, passwd, BBDB complete." - ("autoload")) - - ("tinymailbox" - "Berkeley style mailbox browsing minor mode." - ("autoload")) - - ("tinymy" - "Collection of user (`my') functions. Simple solutions." - ("load" "bind" "bindforce" "defalias" "defadvice")) - - ("tinynbr" - "Number conversion minor mode oct/bin/hex." - ("autoload")) ;; Already autoloaded. M-x turn-on-tinynbr-mode - - ("tinypad" - "Emulate Windows notepad with extra menu." - ("autoload")) - - ("tinypage" - "Handling ^L pages. Select, cut, copy, renumber headings etc." - ("autoload" "bind")) - - ("tinypair" - "Self insert character (pa)irs () \"\" '' <>." - ("autoload" "activate")) - - ;; Please see the documentation in this file - ;; LOAD tinypath.el AS VERY FIRST PACKAGE. Before even tiny-setup.pl - - ("tinypath" - "Manage Emacs startup dynamically." - ()) - - ("tinyperl" - "Grab-bag of Perl language utilities. Pod documentation browser." - ("autoload")) - - ("tinypgp" - "PGP minor mode, remailing, keyring management." - ()) - - ("tinyprocmail" - "Procmail minor mode and coding checker. See http://www.procmail.org/" - ("autoload")) - - ("tinyreplace" - "Handy query-replace, area, case preserve, words." - ("bind")) - - ("tinyrmail" - "RMAIL add-ons, pgp, mime labels, Spam complaint." - ("autoload")) - - ("tinyscroll" - "Enable or Disable auto-scroll for any buffer." - ("autoload")) - - ("tinysearch" - "Grab and search word under cursor." - ("bind" "bindforce" "bindmousealt" "bindmousemeta")) - - ("tinytab" - "Programmed TAB minor mode." - ("autoload" "bind" "bindforce" "bindextra" "bindextraforce")) - - ("tinytag" - "Coding help. E.g. show Java/Perl/C++ function call syntax while coding." - ("autoload")) - - ("tinytf" - "Document layout tool for '(T)echnical text (F)ormat." - ("autoload")) - - ("tinyurl" - "Mark and jump to any URL on current line. Support also C, C++, Perl, Elisp." - ("autoload" "bind")) - - ("tinyvc" - "CVS and RCS log minor mode. Check-out, Check-in." - ("autoload")) - - ("tinyxreg" - "Restore points and window configurations stored in register via X-popup." - ("bind"))) - "Packages and options. This variable is not user configurable. -Format is: - '((PACKAGE ((OPTION-STR ..) ..))).") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; -;; USER SPACE: CONFIGURE SETUP FOR ALL FILES -;; -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; ---------------------------------------------------------------------- -;;; -;;;###autoload -(defun tiny-setup (&optional type option-list) - "Tiny Tools setup controller. See Message buffer for results. - -Please make sure you have run the makefile.pl with build option -\"all\" or \"autoload\". You can verify this by finding files which -contain word \"loaddefs\". - -Autoload statements are always defined when this function is called, -so even if you do not define any options to be installed, they will be -available in callable functions that trigger loading packages. This -means, that you an call e.g function \\[tinytab-mode] and the call -will trigger loading package tinytab.el - -Please notice, that this central setup function configures only the -essential packages, even with TYPE and FEATURE-LIST. The listing -\\[tiny-setup-display] lists many packages that are not loaded -or set up in any default way because a) package's scope is very narrow -and it may not interest the majority b) there is no sensible autoload -and it requires manual settings: tinyload.el and tinypath.el are -good example of this. c) package is a library and it has been -taken cared of by other means. - -Remember that all functions are autoloaded and accessible, although -packages marked may not have default configurations. Here is -sample listing that you may expect from \\[tiny-setup-display] which -displays then content of `tiny-setup-:option-table' when no tiny-setup -configure options are not defined and you should load the package as -instructed in the file itself: - - .. - tinychist - ... - Command history save/restore utility. - tinyload - Load set of packages when Emacs is idle (lazy load). - tinylock - Simple emacs locking utility. - ... - tinynbr - Number conversion minor mode oct/bin/hex. - ... - tinypath - Manage Emacs startup dynamically. - -Here is one way to install packages: a) configure paths automatically b) -load default setup and enable some extra features c) define -delayed loading for some packages that you use most of the time. - - (load \"/ABSOLUTE-PATH/tinypath.el\") - - ;; Define \"ready to use packages\" - - (require 'tiny-setup) - - (tinypath-setup - 'all ;; Activate default features safely - ;; plus features that you want - '(tinyeat--bind - tinydesk--bindforce - tinymy--defadvice ;; Make M-x compile smarter - tinydiff--bind - tinydired--autoload - tinyef--bindextra - tinyeat--bindforce - tinymacro--bindforce - tinydesk--bindforce - tinypair--activate - tinylisp--activate ;; turn on on in all .el buffers - ..)) - - ;; Delayed loading of these packages, when Emacs goes idle. - - (setq tinyload-:load-list - '(\"tinyadvice\" ;; NOTE: for Emacs only. - \"tinymy\" - \"tinymail\" - \"tinygnus\" - \"tinyigrep\" - ..)) - - (require 'tinyload) - -Here is yet another example. The `tiny-setup' function can configure only -the very basic features. You can manually set default values before -packages are loaded (look into each file for interesting things). - - ;; First, configure few packages MANUALLY - - (require 'tinylibm) - - (ti::add-hooks 'tinytf-:mode-define-keys-hook - '(tinytf-mode-define-keys tinytf-mode-define-f-keys)) - - (setq tinymy-:define-key-force t) - (setq tinyef-:mode-key \"\\C-cmr\") - - (setq tinylock-:auto-lock-interval1 45) ;in minutes - - (setq tinyef-:mode-key-table - '((?\[ . step-delete-back) ;KEY -- action symbol - (?\] . step-delete-fwd) - (?\* . chunk-delete) - (?\; . move-back) - (?\' . move-fwd) - (?\~ . e-tilde) - (?\/ . e-slash) - (?\$ . e-dollar))) - - ;; After that, let the central configure tool do the rest - - (require 'tiny-setup) - - (tiny-setup - 'all - '(tinymy--bind-bindemacs - tinytab--bindforce-bindextra - tinyreplace--bindemacs - tinyeat--bindforce)) - -The major TYPE of installation can be one of the following: - - 'autoload - - Setup packages so that they are loaded when the options are needed, - but do not define any key-bindings that already exist. This will - bind free keys to trigger loading packages. - - 'all - - Configure with all options on. This will affect free key-bindings. - - nil - - Autoload files (functions are ready for calling), but - no defaults are configured unless OPTION-LIST is set. - -Alternatively, you can select from OPTION-LIST what packages and what -options inside it will be installed. See list of packages and their -options with command \\[tiny-setup-display] - - The syntax for each package is the same and the symbol passed is - composed from keywords: - - -- Name of package affected, like `tinyeat--'. - - activate Activate feature in all related buffers. - Like turning on `tinylisp-mode' in all Emacs lisp - buffers or `tinyperl-mode' in all perl files. - - bind Bind default keys. This will arrange package - to an autoload state. When a certain key is pressed, - package is loaded. - - bindforce Overwrite any existing Emacs binding. This is like - bind, but without a safe check. - - bindemacs Bind keys that are known to be occupied in Emacs. - - load Load package. If you're tempted to use this, - consider investing to more efficient method described - in tinyload.el. Packages that have complex setup or - which can't be autoloaded easily are categorized as - \"load\". - - autoload Configure package so that it will get loaded if function - related to a package is needed. - - For example, to enable options in tinyadvice.el and tinyurl.el, you could - send option list below. Notice that multiple options for a package - are separated by single dashes. - - (require 'tiny-setup) - (tinypath-setup 'all '(tinyadvice--load tinyurl--autoload-bind ...)) - | | | - | | Option 2. - | Option 1. - Package." - (interactive) - (when (and (interactive-p) - (eq type nil) - (eq option-list nil)) - (setq type 'all)) - (tiny-setup-autoload-read) - (cond - ((eq type 'all) - (tiny-setup-all nil)) - ((eq type 'autoload) - (tiny-setup-all 'autoload-bind))) - (when option-list - (tiny-setup-option-process option-list)) - (message "TinySetup: Done.%s" - (if (ti::xemacs-p) - " See buffer \" *Message-Log*\"" - " See buffer *Messages*"))) - -;;; ---------------------------------------------------------------------- -;;; -(defun tiny-setup-option-process (option-list) - "Process OPTION-LIST described in `tiny-setup'. -OPTION-LIST items items are in form: - - PACKAGE--OPTION-OPTION-OPTION-.. - -Like - - '(tinymy--bind-bindextra) - | | - | option 2 - option 1 - -See also `tiny-setup-:option-table'." - (dolist (elt option-list) - (let* ((name (symbol-name elt)) - (package (if (string-match "\\(^[^ \t-]+\\)--" name) - (match-string 1 name)))) - (if package - (tiny-setup-package package elt) - (message "TinySetup: Invalid setup option format %s" name))))) - -;;; ---------------------------------------------------------------------- -;;; -(defun tiny-setup-all (&optional type) - "Setup all tools with TYPE." - (dolist (elt tiny-setup-:option-table) - (tiny-setup-package (car elt) type))) - -;;; ---------------------------------------------------------------------- -;;; -;;;###autoload -(defun tiny-setup-display (&optional no-descriptions) - "List all packages and available setup options. -With Argument, like, \\[universal-argument], list NO-DESCRIPTIONS." - (interactive "P") - (let* ((buffer (get-buffer-create "*tiny-setup*"))) - (with-current-buffer buffer - (erase-buffer) - (insert "package Supported install options\n" - "----------- " - (make-string 30 ?-) - "\n") - (dolist (elt tiny-setup-:option-table) - (insert (format "%-20s %s\n%-20s %s\n" - (car elt) - (if (null (tiny-setup-nth-options elt)) - "" - (mapconcat - 'identity - (sort (tiny-setup-nth-options elt) 'string<) - " ")) - "" - (tiny-setup-nth-description elt)))) - (insert " -The options can be installed by adding code like this to .emacs: - - (require 'tiny-setup) - (tinypath-setup nil '(tinyadvice--load tinyurl--autoload-bind ...)) -") - (goto-char (point-min)) - (display-buffer (current-buffer))))) - -;;; ---------------------------------------------------------------------- -;;; -(put 'tiny-setup-error-macro 'lisp-indent-function 0) -(put 'tiny-setup-error-macro 'edebug-form-spec '(body)) -(defmacro tiny-setup-error-macro (&rest body) - "Show error." - (` (progn - (pop-to-buffer (get-buffer-create "*TinySetup Error*")) - (,@ body)))) - -;;; ---------------------------------------------------------------------- -;;; -(put 'tiny-setup-dolist-buffer-list 'lisp-indent-function 0) -(put 'tiny-setup-dolist-buffer-list 'edebug-form-spec '(body)) -(defmacro tiny-setup-dolist-buffer-list (&rest body) - "Run BODY in each buffer." - (` - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (,@ body))))) - -;;; ---------------------------------------------------------------------- -;;; -;;;###autoload -(defun tiny-setup-autoload-read () - "Read all autoloads. Makefile must have been run for this to work. -Syntax in Tiny Tools kit bin/ directory: perl makefile.pl autoload." - (condition-case err - (progn - ;; It's better to use `load' and not `require' because user may run - ;; makefile again. - (load "tiny-autoload-loaddefs-tiny") - (load "tiny-autoload-loaddefs-other")) - (error - (let* ((str - (format - (concat - "\ -TinySetup: Error in reading autoload loaddefs. %s - -Symptoms: load-path: - - Please check that your `load-path' contains directories - tiny/lisp/tiny and tiny/lisp/other. - - To check your load path, run \\[tinypath-load-path-display] - or run this lisp code: - - (insert (prin1-to-string load-path)) - | - Put cursor here and press - C-u C-x C-e - -Symptoms: autoload files: - - Check that the tiny-autoload*el files are present in these directories. - If there is no autoload files, create them by running makefile: - - cd bin/ - perl makefile.pl --verbose 2 autoload. - -Symptoms: compiled files - - There may be problem with compiled tiny-autoload*.elc files. - Please remove all *.elc files and try again.") - (prin1-to-string err)))) - ;; Write to *Message* buffer - (message str) - (tiny-setup-error-macro - (insert str - " - -Symptoms for tinypath.el usage: - - If you use tinypath.el, it may be possible that it didn't find the - default ~/elisp or ~/lisp directories. Please move all your Emacs setup - files under one of these directories. Alternatively set the location - of your private lisp with: - - (require 'cl) - - (setq tinypath-:load-path-root '(\"~/your-lisp-dir-location\")) - (pushnew \"/ABSOLUTE/INSTALLATION-PATH/HERE\" - load-path - :test 'string=) - (load \"tinypath\") - - (require 'tiny-setup) - (tiny-setup 'all) - - Refer to doc/txt/README.txt in tiny-tools kit and - \\[tinypath-version] documentation for more instructions how to let - tinypath.el set the `load-path' automatically.")) - (error str))))) - -;;; ---------------------------------------------------------------------- -;;; -(defun tiny-setup-option-strings (type) - "Return list of options from symbol TYPE." - (setq type (symbol-name type)) - (if (not (string-match "--\\(.*\\)" type)) - type - (split-string (match-string 1 type) "[-]"))) - -;;; ---------------------------------------------------------------------- -;;; -(defun tiny-setup-package-require (package) - (message "TinySetup: %s loaded." package) - (unless (featurep (intern package)) - (message "TinySetup: %s LOADED." package) - (require (intern package)))) - -;;; ---------------------------------------------------------------------- -;;; -(defun tiny-setup-package-option-p (package opt option-list) - "Check if PACKAGE and OPT is part of user requested OPTION-LIST." - (let (ret) - (dolist (elt option-list) - (when (string= elt opt) - (setq ret t) - (return))) - (unless ret - (message "TinySetup: [%s] No option [] found for `%s'" - package - (if (eq 1 (length option-list)) - (car option-list) - (prin1-to-string option-list)))) - ret)) - -;;; ---------------------------------------------------------------------- -;;; -(defun tiny-setup-package (package &optional type) - "Activate PACKAGE with TYPE. -If TYPE is nil, activate all options that do not contain word -`force' or `load'." - (let* ((req-options (and type - (tiny-setup-option-strings type))) - (list (tiny-setup-package-options package))) - (cond - ((null list) - (message "TinySetup: %-15s No options to configure." - package)) - (t - (unless req-options ;; nil, activate almost all - (dolist (option list) - (unless (string-match "^load\\|force" option) - (push option req-options)))) - (let* (function - sym) - (dolist (option req-options) - (cond - ((not (member option list)) - (message "TinySetup: Unknown option %s. Choose from %s" - option - (prin1-to-string list))) - (t - (setq function (format "tiny-setup-%s-%s" package option)) - (setq sym (intern-soft function)) - (cond - ((and (null sym) - (string= option "load")) - (tiny-setup-package-require package)) - ((null sym) - (message "TinySetup: ERROR Unknown function %s" - function)) - (t - (setq function sym) - (message "TinySetup: %-15s configured with `%s'" package option) - (funcall function))))))))))) - -;;; ---------------------------------------------------------------------- -;;; -(defun tiny-setup-nth-options (elt) - "Return option list from ELT." - (nth 2 elt)) - -;;; ---------------------------------------------------------------------- -;;; -(defun tiny-setup-nth-description (elt) - "Return option list from ELT." - (nth 1 elt)) - -;;; ---------------------------------------------------------------------- -;;; -(defun tiny-setup-package-options (package) - "Return list of options for PACKAGE." - (let ((elt (assoc package tiny-setup-:option-table))) - (when elt - (tiny-setup-nth-options elt)))) - -;;; ---------------------------------------------------------------------- -;;; -(defun tiny-setup-define-key-1 - (key keymap function &optional prefix str force) - "Define KEY to KEYMAP using FUNCTION if not yet occupied. - -Input: - - KEY Key definitions - KEYMAP The map. - FUNCTION function to bind - PREFIX Message prefix. Like \"Package:\" who requested change. - STR Human readable key definition. Shown to user. - FORCE Override key definition without a check." - (setq str (if (stringp str) - (format "\"%s\"" str) - "")) - (let ((def (lookup-key keymap key))) - (cond - (force - (message "%sKey %-10s%s set to `%s' (FORCED, was `%s')." - (or prefix "") - (prin1-to-string key) - str - (symbol-name function) - def) - (define-key keymap key function)) - (t - (cond - ((or (eq def function) - (memq def '(nil ignore)) - ;; Lookup key returns NBR if the sequence of keys exceed - ;; the last keymap prefix - ;; C-cck --> C-cc is undefined, so there is no C-c c map yet - (integerp def)) - (message "%sKey %-10s%s set to `%s'." - (or prefix "") - (prin1-to-string key) - str - (symbol-name function)) - (define-key keymap key function)) - (t - (message - "%sKey %-10s%s already has a definition `%s'. Not set to `%s'" - (or prefix "") - (prin1-to-string key) - str - (prin1-to-string def) - (symbol-name function)))))))) - -;;; ---------------------------------------------------------------------- -;;; -(defun tiny-setup-define-key (key keymap function &optional str force) - "Define KEY to KEYMAP using FUNCTION. Display STR and FORCE binding." - (tiny-setup-define-key-1 - key keymap function "TinySetup: " str force)) - -;;; ---------------------------------------------------------------------- -;;; -(defun tiny-setup-alist-search (alist regexp) - "Search ALIST for REGEXP." - (dolist (elt alist) - (if (string-match regexp (car elt)) - (return elt)))) - -;;; ---------------------------------------------------------------------- -;;; -(defun tiny-setup-aput (sym regexp key value &optional force) - "Search SYM's for REGEXP and set KEY to VALUE if not found. -This function effectively compares each key in SYM to REGEXP and -if there is no matches, it adds new (KEY . VALUE) pair. - -Useful, if something needs to be added to the `auto-mode-alist', but -previous definitions must be preserved." - (let* ((found (tiny-setup-alist-search (symbol-value sym) regexp))) - (cond - ((and found - (eq (cdr found) value)) - (message "TinySetup: `%s' now contains (%s . %s)" - (symbol-name sym) - key - value)) - (found - (message "TinySetup: `%s' already contains %s. Not set to (%s . %s)" - (symbol-name sym) - (prin1-to-string found) - key - value)) - (t - (message "TinySetup: `%s' now contains (%s . %s)" - (symbol-name sym) - key - value)) - (push (cons key value) (symbol-value sym))))) - -;;; ---------------------------------------------------------------------- -;;; -(defun tiny-setup-defalias (symbol definition) - "Like `defalias' but with verbose messages." - (message "TinySetup: defalias `%s' => `%s'" - (symbol-name symbol) - (symbol-name definition)) - (defalias symbol definition)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; -;; TIMING UTILITIES -;; These are admistrative utilies for package maintainer(s) -;; -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; ---------------------------------------------------------------------- -;;; -(defun tiny-setup-time-difference (a b) - "Calculate difference between times A and B. -The input must be in form of '(current-time)' -The returned value is difference in seconds. -E.g. if you want to calculate days; you'd do -\(/ (ti::date-time-difference a b) 86400) ;; 60sec * 60min * 24h" - (multiple-value-bind (s0 s1 s2) a - (setq a (+ (* (float (ash 1 16)) s0) - (float s1) (* 0.0000001 s2)))) - (multiple-value-bind (s0 s1 s2) b - (setq b (+ (* (float (ash 1 16)) s0) - (float s1) (* 0.0000001 s2)))) - (- a b)) - -;;; ---------------------------------------------------------------------- -;;; -(defvar tiny-setup-:time nil) -(put 'tiny-setup-time-this 'lisp-indent-function 0) -(put 'tiny-setup-time-this 'edebug-form-spec '(body)) -(defmacro tiny-setup-time-this (&rest body) - "Run BODY with and time execution. Time is in `my-:tmp-time-diff'." - (` - (let* ((tmp-time-A (current-time)) - tmp-time-B) - (,@ body) - (setq tmp-time-B (current-time)) - (setq tiny-setup-:time - (tiny-setup-time-difference tmp-time-B tmp-time-A))))) - -;;; ---------------------------------------------------------------------- -;;; -(defun tiny-setup-time-load-file (file) - "Time lisp FILE loading." - (interactive "fload file and time it: ") - (tiny-setup-time-this - (load file)) - (message "Tiny: Timing %-15s took %12f secs" file tiny-setup-:time)) - -;;; ---------------------------------------------------------------------- -;;; -(defun tiny-setup-test-load-time-libraries () - "Time package load times." - (interactive) - (message "\n\n** Tiny setup: timing test start\n") - (message "load-path: %s" - (prin1-to-string load-path)) - (let* ((path (locate-library "tinylib.el")) - (time-a (current-time)) - time-b) - (if (not path) - (message "Tiny: [timing] Can't find tinylib.el along `load-path'") - (setq path (file-name-directory path)) - (dolist (pkg (directory-files path 'full "^tinylib.*el")) - (tiny-setup-time-load-file pkg)) - (setq time-b (current-time)) - (message "Tiny: total time is %s seconds" - (tiny-setup-time-difference time-b time-a)) - (display-buffer "*Messages*")))) - -;;; ---------------------------------------------------------------------- -;;; -(defun tiny-setup-test-load-all () - "Load each package to check against errors." - (interactive) - (message "\n\n** Tiny setup: load test start\n") - (let* ((path (locate-library "tinylib.el"))) - (if (not path) - (message "Tiny: [load test] Can't find tinylib.el along `load-path'") - (setq path (file-name-directory path)) - (dolist (pkg (directory-files path 'full "^tiny.*el")) - (load pkg)) - (display-buffer "*Messages*")))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; -;; AUTOLOAD UTILITIES -;; These are admistrative utilies for package maintainer(s) -;; -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; ---------------------------------------------------------------------- -;;; -(defun tiny-setup-directory-last (dir) - "Return last directory name in DIR. /dir1/dir2/ -> dir2." - (if (string-match "[/\\]\\([^/\\]+\\)[/\\]?$" dir) - (match-string 1 dir) - "")) - -;;; ---------------------------------------------------------------------- -;;; -(defun tiny-setup-directory-to-file-name (dir template) - "Make file name from NAME and TEMPLATE.