From: Don Armstrong Date: Tue, 3 Jun 2008 23:10:07 +0000 (+0000) Subject: add tiny-tools X-Git-Url: https://git.donarmstrong.com/?p=lib.git;a=commitdiff_plain;h=fd3f330b392dfae044a1fc13082e9f4781d2041d add tiny-tools --- diff --git a/emacs_el/tiny-tools/other/c-comment-edit2.el b/emacs_el/tiny-tools/other/c-comment-edit2.el new file mode 100644 index 0000000..bb4824a --- /dev/null +++ b/emacs_el/tiny-tools/other/c-comment-edit2.el @@ -0,0 +1,853 @@ +;;; 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 new file mode 100644 index 0000000..093ce68 --- /dev/null +++ b/emacs_el/tiny-tools/other/calist.el @@ -0,0 +1,265 @@ +;;; 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 new file mode 100644 index 0000000..012fd68 --- /dev/null +++ b/emacs_el/tiny-tools/other/complete-menu.el @@ -0,0 +1,431 @@ +;;; 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 new file mode 100644 index 0000000..adbdd5a --- /dev/null +++ b/emacs_el/tiny-tools/other/date-parse.el @@ -0,0 +1,341 @@ +;;; 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 new file mode 100644 index 0000000..20c1133 --- /dev/null +++ b/emacs_el/tiny-tools/other/dired-sort.el @@ -0,0 +1,478 @@ +;;; 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 new file mode 100644 index 0000000..ffe3f1d --- /dev/null +++ b/emacs_el/tiny-tools/other/expect.el @@ -0,0 +1,353 @@ +;;; 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 new file mode 100644 index 0000000..26dd11b --- /dev/null +++ b/emacs_el/tiny-tools/other/fnexpand.el @@ -0,0 +1,578 @@ +;;; 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 new file mode 100644 index 0000000..1756d39 --- /dev/null +++ b/emacs_el/tiny-tools/other/folding.el @@ -0,0 +1,5364 @@ +;;; 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 new file mode 100644 index 0000000..ba308fe --- /dev/null +++ b/emacs_el/tiny-tools/other/tiny-autoload-loaddefs-other.el @@ -0,0 +1,390 @@ +;;; 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 new file mode 100644 index 0000000..b824222 --- /dev/null +++ b/emacs_el/tiny-tools/tiny/load-path.el @@ -0,0 +1,140 @@ +;;; 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 new file mode 100644 index 0000000..2d7a662 --- /dev/null +++ b/emacs_el/tiny-tools/tiny/tiny-autoload-loaddefs-tiny.el @@ -0,0 +1,1853 @@ +;;; 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 new file mode 100644 index 0000000..dae1ec1 --- /dev/null +++ b/emacs_el/tiny-tools/tiny/tiny-setup.el @@ -0,0 +1,2204 @@ +;;; 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.