;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Table-Of-Content Editing Helpers ;;; ;;; Idea: Structure & Navigate through larger files ;;; ;;; Functionalities: ;;; ;;; * construct file headers with file information ;;; * structuring ordinary text files ;;; by having 4 levels of headings ;;; * inserting regularly formed comment ;;; * attaching comments at the end of line ;;; * create a table of contents ;;; ;;; Primary use is for pure text files and (La)TeX sources; ;;; However, it may be useful for writing source code, ;;; scripts, HTML, and similar. ;;; ;;; E.g., this file, was edited with the functions it provides. ;;; ------------------------------------------------------------- ;;; ;;; Important New Commands: ;;; ;;; * copy-last-line ;;; * copy-last-complex-statement ;;; * text-insert-headline ;;; * text-insert-semaphore ;;; * text-insert-end-line-comment ;;; * compute-table-of-contents ;;; * jump-to-headline ;;; * wrap-ispell ;;; ;;; Initialization of keyboard macros: ;;; tocedit-init ;;; ;;; Regretful Thoughts: ;;; Parts of this files are rather old and crufty; ;;; Just never got around re-implementing the more ugly parts, ;;; (forgive me) ;;; ;;; ------------------------------------------------------------- ;;; $Id: om-tocedit.el,v 1.4 2012/04/25 19:38:36 oli Exp $ ;;; ------------------------------------------------------------- ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @TABLE OF CONTENTS: [TOCD: 23:07 12 Dec 2001] ;;; ;;; [1] Constants ;;; [1.1] Personal Settings (PLEASE CUSTOMIZE) ;;; [1.2] Suffixes ;;; [1.3] Prefixes ;;; [1.4] Other ;;; [1.5] Dummies ;;; [2] Variable Settings ;;; [3] Needed Elisp Macros ;;; [4] Ordinary Text Manipulation ;;; [4.1] Removing and Copying ;;; [4.1.1] Cutting and Killing ;;; [4.1.2] Positioning ;;; [4.1.3] Simple Text Replacement ;;; [4.2] Text Manipulation: Snip ;;; [4.3] Headings & Captions ;;; [4.4] Semaphores (separating-lines) ;;; [4.5] End-line-comments ;;; [5] Disclaimer ;;; [6] Templates ;;; [7] Computing Table of Contents (TOC) ;;; [7.1] Jump to TOC entries ;;; [8] Spell Checking ;;; [8.1] Shared Documents: (a)LAST ;;; [9] Activating key-bindings ;;; [9.1] Macro Definitions ;;; [9.2] Binding ;;; ///////////////////////////////////////////////////////// ;;; @FILE: om-tocedit.el ;;; @PLACE: Saturn Homestation ;;; @FORMAT: emacs lisp ;;; @AUTHOR: M. Oliver M'o'ller ;;; @BEGUN: Wed Jun 14 21:11:14 2000 ;;; @VERSION: V1.2 Wed Apr 25 21:37:22 2012 ;;; ///////////////////////////////////////////////////////// ;;; @SPELL: american Wed Dec 12 17:11:26 2001 ;;; ////////////////////////////////////////////////////////////////// ;;; [1] Constants ;;; ////////////////////////////////////////////////////////////////// ;;; ////////////////////////////////////////////// ;;; [1.1] Personal Settings (PLEASE CUSTOMIZE) ;;; ////////////////////////////////////////////// (defconst *my-full-name* "Max Musterman") (defconst *my-email-address* "someone@somewhere.edu") (defconst *home* (getenv "HOME")) (defconst *default-local-place* (getenv "HOST")) (defconst *usual-edit-width* 78) (defconst *usual-html-doc-type* "") (defconst *usual-xml-doc-type* "") (defconst *usual-c++-preamble* "// -*- mode: C++; c-file-style: \"stroustrup\"; c-basic-offset: 4; -*-") (defconst *usual-java-preamble* "// -*- mode: JDE; c-basic-offset: 2; -*-") ;;; ////////////////////////////////////////////// ;;; [1.2] Suffixes ;;; ////////////////////////////////////////////// (defconst *listof-html-type-suffixes* '("html" "xml" "dtd" "shtml" "htm" "php3") "Suffixes of filenames that should be treated like HTML.") (defconst *listof-sml-type-suffixes* '("ml" "oml" "cml" "sml" ) "Suffixes of filenames that should be treated like SML.") (defconst *listof-lisp-type-suffixes* '("cl" "el" "emacs" "lisp" "lis" "acl" "ccl") "Suffixes of filenames that should be treated like lisp.") (defconst *listof-c-type-suffixes* '("c" "cc" "h" "hh" "c++" "cpp") "Suffixes of filenames that should be treated like C.") (defconst *listof-tex-type-suffixes* '("tex" "bib" "masterbib" "sty" "pictex") "Suffixes of filenames that should be treated like TeX.") ;;; ////////////////////////////////////////////// ;;; [1.3] Prefixes ;;; ////////////////////////////////////////////// (defconst *listof-xmodmap-type-prefixes* '(".xmodmaprc" ) "Prefixes of filenames that should be treated like .xmodmaprc.") ;;; ////////////////////////////////////////////// ;;; [1.4] Other ;;; ////////////////////////////////////////////// (defconst *default-template-directory* (concat *home* "/emacs/Templates") "Directory that contains template files .tpl.") (defconst *start-of-time-regexp* "\$Sun \\|Mon \\|Tue \\|Wed \\|Thu \\|Fri \\|Sat \$" "Regular expression that is searched for, when updating the ()VERSION stamp. Strings (nonmatching) located before that are skipped.") (defconst *start-of-time-or-exception-regexp* "\$Sun \\|Mon \\|Tue \\|Wed \\|Thu \\|Fri \\|Sat \\|UNCHECKED \\|UNFINISHED \$" "Regular expression that is searched for with wrap-ispell.") ;;; ////////////////////////////////////////////// ;;; [1.5] Dummies ;;; ////////////////////////////////////////////// (defvar ispell-dictionary "american") (defvar ispell-local-dictionary nil) (defvar *temporary-function-name* 'very_ugly_underscored_2821_name_for_temporary_function "Used by my-execute-string.") (defvar *last-saved-message* "" "Saving a message that was issued by message-save") ;;; ////////////////////////////////////////////////////////////////// ;;; [2] Variable Settings ;;; ////////////////////////////////////////////////////////////////// ;; -- Disclaimer ------------------------------------------------ (defvar *auto-all-count-when-copy-this-line* t "*If set to true: If the cursor is on a number, replaces this number in the whole line by it's successor.") (defvar *allow-multiple-version-replacements* nil "*If t, not only the first occurence of (@)version is replaced, but all of them.") (make-variable-buffer-local '*allow-multiple-version-replacements*) (defvar *propagate-first-version-occurrence-to-other* t "*If true, and *allow-multiple-version-replacements* is also true, then the string derived from the first occurrence of (@)version is used in all other (@)version locations.") (make-variable-buffer-local '*propagate-first-version-occurrence-to-other*) (defvar *allow-new-disclaimer-if-version-exists* nil "*If t, then a new disclaimer is inserted, regardless of the possible existence of a previous one.") (defvar *update-place-if-existent* t "*If t, then whenever the disclaimer is updated, so is the place.") (defvar *insert-place-if-not-existent* t "*If t, whenever the disclaimer is updated, so is the place. If required, it will be newly inserted (after the FILE line).") (defvar *update-last-if-existent* t "*If t, then whenever the disclaimer is updated, so is the last tag.") (defvar *alist-for-copy-last-complex-statement* nil "*Contains a list of (MODE . FUNCTION-NAME) that tells which function to call" ) (defvar *disclaimer-inherit-synopsis* t "*If non-nil, when inserting original disclaimer, browse the list of buffers for a file containing @version. If this is present, copy-paste the synopsis (after stripping off the comment symbols).") ;; -- Template Related ------------------------------------------ (defvar *template-escape-expression-start* "\\\\{" "The start of the escape expression" ) (defvar *template-escape-expression-end* "}" "The end of the escape expression. This expression must be reachable in the template *directly* ! If you want to exclude some text that contains this expression here, you might want to change it." ) ;; -- Headline/Semaphore/End of line comment -------------------- (defvar *allow-headline-recomputation* t "*If t, then check whenever a headline is called, whether already one (textually) exists. If yes, remove the old headline before inserting the new one.") (defvar *allow-semaphore-recomputation* t "*If t, then check whenever a text-semaphore (one-line-comment) is called, whether already one (textually) exists. If yes, remove the old semaphore-signs before inserting the new one.") (defvar *allow-end-line-comment-recomputation* t "*If t, then check whenever a text-end-line-comment (one-line comment with ---s up to a certain position) is called, whether already one (textually) exists. If yes, remove the old end-line-comment-signs before inserting the new ones.") (defvar *headline-indent-before-inserting* t "*If t, then the headline lines are indented before they are inserted.") (defvar *semaphore-indent-before-inserting* t "*If t, then the semaphore lines are indented before they are inserted.") (make-variable-buffer-local '*headline-indent-before-inserting*) (make-variable-buffer-local '*semaphore-indent-before-inserting*) ;; -- Table of Contents Setups --------------------------------------------- (defvar *toc-indent-length* 4 "*\nLength of indentation in the table of contents.") (make-variable-buffer-local '*toc-indent-length*) (defvar *toc-start-chapter* 1 "*\nCounter start for chapter (see compute-table-of-contents)") (defvar *toc-start-section* 1 "*\nCounter start for section (see compute-table-of-contents)") (defvar *toc-start-subsection* 1 "*\nCounter start for subsection (see compute-table-of-contents)") (defvar *toc-start-subsubsection* 1 "*\nCounter start for subsubsection (see compute-table-of-contents)") (defvar *toc-additionally-collect-lines-pattern* "^[%].*\$!!\\|[?][?]\$" "*\nIf non-nil, all lines that match the regular expression described in this variable are added to the table of contents. Very useful for live documents with points still to add.") (defvar *toc-additionally-line-truncation* 65 "*\nIf non-nil, truncate additional table-of-contents line after column declared in this variable.") ;(setq *toc-additionally-collect-lines-pattern* "\$[\\]label{\\|^[%].*\\(!!\\|[?][?]\$\\)") ;(setq *toc-additionally-collect-lines-pattern* "^[%].*\$!!\\|[?][?]\$") ;(setq *toc-additionally-line-truncation* 65) ;; ---------------------------------------------------- (make-variable-buffer-local '*toc-start-chapter*) (make-variable-buffer-local '*toc-start-section*) (make-variable-buffer-local '*toc-start-subsection*) (make-variable-buffer-local '*toc-start-subsubsection*) (make-variable-buffer-local '*toc-additionally-collect-lines-pattern*) (make-variable-buffer-local '*toc-additionally-line-truncation*) ;; ---------------------------------------------------- (defvar *toc-threshold-huge* 70 "*\nThreshold for accepting huge headers") (defvar *toc-threshold-big* 50 "*\nThreshold for accepting big headers") (defvar *toc-threshold-medium* 30 "*\nThreshold for accepting medium headers") (make-variable-buffer-local '*toc-threshold-huge*) (make-variable-buffer-local '*toc-threshold-big*) (make-variable-buffer-local '*toc-threshold-medium*) (defvar *toc-numbering-start-brace* "[" "*\nBrace starting a chapter/section number in the table of contents.") (defvar *toc-numbering-end-brace* "]" "*\nBrace ending a chapter/section number in the table of contents.") (make-variable-buffer-local '*toc-numbering-start-brace*) (make-variable-buffer-local '*toc-numbering-end-brace*) (defvar *toc-insert-new-numbering* t "*\nIf t, write the newly computed numbering into the headline.") (defvar *toc-delete-old-numbering* t "*\nIf t, removes the old numbering; a new one is inserted, iff *toc-insert-new-numbering* is t, otherwise the old one will be kept. If this is nil, *toc-insert-new-numbering* has no effect, none will be inserted.") (make-variable-buffer-local '*toc-insert-new-numbering*) (make-variable-buffer-local '*toc-delete-old-numbering*) ;; -- spell checking ------------------------------------------------------- (defvar *spell-check-start-pattern* "^--text follows this line--" "*\nDefines a regular expression, that gives the start of the (buffer-local) spell check. If null or not found, spell check begins at the beginning.") (defvar *spell-check-end-pattern* "^- oli[ \t\n\r]" "*\nDefines a regular expression, that gives the end of the (buffer-local) spell check. The direction on how to search this, is defined with the variable *spell-check-search-end-pattern-foward-from-start*. If pattern is null or not found, spell check continues to the end of buffer.") (defvar *spell-check-search-end-pattern-forward-from-start* nil "*\nIf non-nil, search *forward* for end pattern.") (make-variable-buffer-local '*spell-check-start-pattern*) (make-variable-buffer-local '*spell-check-end-pattern*) (make-variable-buffer-local '*spell-check-search-end-pattern-forward-from-start*) ;; -- fixing possibly undefined variables ---------------------------------- (defvar *bash-program-call* "" "DUMMY") (defvar *perl-program-call* "" "DUMMY") ;;; ////////////////////////////////////////////////////////////////// ;;; [3] Needed Elisp Macros ;;; ////////////////////////////////////////////////////////////////// ;;; The following is very unstructured, mainly because it was taken ;;; piece by piece from another macro file (my-lisp-macros). ;;; With any luck, you will not experience name clashes. (defmacro my-loop-for-i-from-downto-do (start end &rest exec) (list 'let (list (list 'i start) (list 'ex 'nil)) (list 'while (list '>= 'i end) (list 'setq 'ex (list 'quote exec)) (list 'while (list 'not (list 'null 'ex)) (list 'eval (list 'car 'ex)) (list 'setq 'ex (list 'cdr 'ex))) (list 'setq 'i (list '- 'i 1)) ))) (defmacro my-loop-for-e-in-do (list &rest exec) (list 'let (list (list 'e 'nil) (list 'l list) (list 'ex 'nil)) (list 'while (list 'not (list 'listp 'l)) (list 'setq 'l (list 'eval 'l))) (list 'while (list 'not (list 'null 'l)) (list 'setq 'e (list 'car 'l)) (list 'setq 'l (list 'cdr 'l)) (list 'setq 'ex (list 'quote exec)) (list 'while (list 'not (list 'null 'ex)) (list 'eval (list 'car 'ex)) (list 'setq 'ex (list 'cdr 'ex))) ))) (defmacro my-loop-for-i-from-to-do (start end &rest exec) (list 'let (list (list 'i start) (list 'ex 'nil)) (list 'while (list '<= 'i end) (list 'setq 'ex (list 'quote exec)) (list 'while (list 'not (list 'null 'ex)) (list 'eval (list 'car 'ex)) (list 'setq 'ex (list 'cdr 'ex))) (list 'setq 'i (list '+ 'i 1)) ))) (defmacro my-push (e var) (list 'setq var (list 'cons e var))) (defmacro scon (&rest args) (list 'let (list (list 's "") (list 'a (list 'quote args))) (list 'while (list 'not (list 'null 'a)) (list 'setq 's (list 'format "%s%s" 's (list 'eval (list 'car 'a)))) (list 'setq 'a (list 'cdr 'a))) 's)) (defmacro my-loop-for-e-in-append (list &rest exec) (list 'let (list (list 'e 'nil) (list 'l list) (list 'ex 'nil) (list 'res 'nil)) (list 'while (list 'not (list 'null 'l)) (list 'setq 'e (list 'car 'l)) (list 'setq 'l (list 'cdr 'l)) (list 'setq 'ex (list 'quote exec)) (list 'while (list 'not (list 'null 'ex)) (list 'setq 'res (list 'append 'res (list 'eval (list 'car 'ex)))) (list 'setq 'ex (list 'cdr 'ex)))) 'res)) ;; -- commands ------------------------------------------------------------- (defun my-reverse (l) (if (null l) l (append (my-reverse (cdr l)) (list (car l))))) (defun kill-number-at-point () "Kill the (integer) number the point is at; possibly kills an empty region." (interactive) (let ((pos (point-marker)) (start nil)) (forward-char 1) (search-backward-regexp "[^0123456789]") (forward-char 1) (setq start (point-marker)) (search-forward-regexp "[^0123456789]" (point-max) t) (backward-char 1) (kill-region start (point-marker)) (message (format "Killed: >>%s<<" (car kill-ring))) (car kill-ring))) (defun get-current-filename () "Get the (absolute) current filename. If a version is give, strip it off." (interactive) (let* ((current-pwd (pwd)) (name (stripoff-version-if-present (buffer-name))) (full-name (my-substring (format "%s%s" current-pwd name) 10))) (insert-in-killring full-name) full-name)) (defun stripoff-version-if-present (string) "Remove a suffix from a string." (let ((buf (buffer-name)) (pos nil)) (set-buffer "*scratch*") (end-of-buffer) (setq pos (point-marker)) (insert string) (goto-char pos) (replace-regexp "<[0123456789]*>$" "" ) (kill-new "") (kill-region pos (point-max)) (message (car kill-ring)) (set-buffer buf) (car kill-ring))) (defun this-is-end-of-line () "Returns true, if current column is identical to the last position in line" (let ((pos (point-marker)) (res nil)) (end-of-line) (if (equal (point-marker) pos) (setq res t)) (goto-char pos) res)) (defun goto-previous-whitespace () "Move point before the (strictly) previous whitespace or to the beginning of file, if it does not exist." (interactive) (if (search-backward-regexp "\$ \\|\r\\|\n\\|\t\\|$\$" (point-min) t) nil (goto-char (point-min)))) (defun goto-next-whitespace () "Move point before the next whitespace or to the end of file." (interactive) (if (search-forward-regexp "\$ \\|\r\\|\n\\|\t\\|$\$" (point-max) t) (backward-char 1) (goto-char (point-max)))) (defun goto-next-non-whitespace () "Move point before the (non-strictly) next non-whitespace or to the end of file, if it does not exist." (interactive) (if (search-forward-regexp "[^ \r\n\t]" (point-max) t) (backward-char 1) (goto-char (point-max)))) (defun goto-previous-non-whitespace () "Move point before the (strictly) previous non-whitespace or to the beginning of file, in case it does not exist." (interactive) (if (search-backward-regexp "[^ \r\n\t]" (point-min) t) nil (goto-char (point-min)))) (defun my-string-starts-with (s start) (interactive) (let ((s-c (my-string-to-charlist s)) (start-c (my-string-to-charlist start))) (if (> (length start-c) (length s-c)) nil (let ((res t)) (my-loop-for-i-from-to-do 0 (- (length start-c) 1) (if (equal (nth i s-c) (nth i start-c)) nil (setq res nil))) res)))) (defun my-string-reverse (string) (interactive) (my-charlist-to-string (my-reverse (my-string-to-charlist string)))) (defun some-in-list (fun l) "Apply fun on elements in list, return first result that is non-nil, and nil if no such exits." (if (null l) nil (or (funcall fun (car l)) (some-in-list fun (cdr l))))) (defun my-string-ends-with (s ending) (interactive) (my-string-starts-with (my-string-reverse s) (my-string-reverse ending))) (defun stripoff-path-from-filename (string) "Delete everything before /" (interactive) (let ((sep-char (aref "/" 0)) (s-list (my-reverse (my-string-to-charlist string))) (res nil)) (while (and (not (null s-list)) (not (eq (car s-list) sep-char))) (my-push (car s-list) res) (setq s-list (cdr s-list))) (my-charlist-to-string res))) (defun buffer-name-without-version () "Return buffer-name, but without any suffixes ." (stripoff-version-if-present (buffer-name))) (defun my-get-filename-suffix-respect-override (&rest filename) "Return everything *after* the last dot in filename as a string. If a version is given, strip it off first. If the suffix is \"override\", add the suffix before." (let* ((fn (if (null filename) (get-current-filename) (car filename))) (sf (my-get-filename-suffix fn)) (suffix (if (string= sf "override") (format "%s.%s" (my-get-filename-suffix (my-substring fn 0 (- (length fn) (length sf) 1))) sf) sf))) (message (format "Suffix: %s" suffix)) suffix)) (defun point-end-of-this-line () "Returns position of the end of this line." (let ((tmp (point-marker)) (res nil)) (end-of-line) (setq res (point-marker)) (goto-char tmp) res)) (defun query-approval (&rest r) (interactive) (let* ((string (if r (car r) "Continue")) (approval (read-input (format "%s [Y]? " string)))) (if (or (equal approval "") (equal approval "Y") (equal approval "y") (equal approval "yes")) t nil))) (defun my-hex-string-to-number (s) "Converts a hexadecimal string to a (elisp) number." (my-string-to-number s 16)) (defun delete-until-next-nonspace () "delete all characters until the next space; does not work properly, if preceded by a kill (move cursors to fix this or call macro better-delete-until-next-nonspace)" (interactive) (kill-new "") (let ((not-done t) (pos (point-marker))) (while not-done (delete-char 1 t) (if (and (not (equal (car kill-ring) " ")) (not (equal (car kill-ring) "\r")) (not (equal (car kill-ring) "\n")) (not (equal (car kill-ring) "\t")) ) (setq not-done nil)) ) (insert (car kill-ring)) (backward-char 1))) (defun insert-in-killring (string) (kill-new string)) (defun my-forward-find-matching-nesting (open close &rest no-error) (interactive) "Takes a pair of nesting strings -- open and close, e.g. \"(\" and \")\". Sets point *after* the last closing string of nearest complete nesting from point, searched forward. If this point exists, a non-nil value is returned, otherwise nil. An optional argument prevents abortion with an error in the case the next logical open/close brace is not found." (my-clear-killring) (message "** forward searching end of scope...") (let ((balance 0) (old-pos (point-marker)) (pattern (format "\$%s\\|%s\$" (regexp-escape-string open) (regexp-escape-string close))) (tmp nil) (result t)) (while (and result (>= balance 0)) (if (search-forward-regexp pattern (point-max) no-error) nil (setq result nil)) (if result (progn (setq tmp (point-marker)) (backward-char 1) (kill-ring-save (point-marker) tmp) (forward-char 1) (if (equal (car kill-ring) open) (setq balance (+ 1 balance))) (if (equal (car kill-ring) close) (setq balance (- balance 1)))))) (if result (message (format "** positioned after last matching >>%s<<." close)) (progn (goto-char old-pos) (message (format "** no forward matching >>%s<< found." close)))) result)) (defun my-backward-find-matching-nesting (open close &rest no-error) "Takes a pair of nesting strings -- open and close, e.g. \"(\" and \")\". Sets point after the opening string of the surrounding context. Does return non-nil, if this is found. If it is not found, maintains position and returns nil. An optional argument prevents abortion with an error in the case the next logical open/close brace is not found." (interactive) (my-clear-killring) (message "** backwards searching beginning of scope...") (let* ((balance 0) (old-pos (point-marker)) (pattern (format "\$%s\\|%s\$" (regexp-escape-string open) (regexp-escape-string close))) (tmp nil) (result t)) (while (and result (>= balance 0)) (if (search-backward-regexp pattern (point-min) no-error) nil (setq result nil)) (if result (progn (setq tmp (point-marker)) (forward-char 1) (kill-ring-save tmp (point-marker)) (if (equal (car kill-ring) close) (setq balance (+ 1 balance))) (if (equal (car kill-ring) open) (setq balance (- balance 1))) (backward-char 1)))) (forward-char 1) (if result (message (format "** positioned after matching >>%s<<." open)) (progn (message "** no surrounding context found") (goto-char old-pos))) result)) (defun my-forward-find-matching-parentheses (&rest no-error) "Sets point *after* the matching parenthesis closing the nearest complete context from point (searched forward). If this point exists, a non-nil value is returned, otherwise nil." (interactive) (eval (list 'my-forward-find-matching-nesting "(" ")" (car no-error)))) (defun my-backward-find-matching-parentheses (&rest no-error) "Sets point after the opening parentheses of the surrounding context. Does return non-nil, if this is found. If it is not found, maintains position and returns nil." ;; older-functionality addition ;If a (positive) offset is provided, then it might find not *this* context, but ;some outer-more one, e.g. offset 1 goes 1 brace before the ;surrounding context. (interactive) (eval (list 'my-backward-find-matching-nesting "(" ")" (car no-error)))) (defun my-forward-find-matching-brace (&rest no-error) "Find the } the current block ends with. Returns a non-nil value, if this brace was found. If called with an argument, no error is issued if no such brace if found." (interactive) (eval (list 'my-forward-find-matching-nesting "{" "}" (car no-error)))) (defun my-backward-find-matching-brace (&rest no-error) "Find the { the current block starts with. If called with an argument, no error is issued if no such brace if found." (interactive) (eval (list 'my-backward-find-matching-nesting "{" "}" (car no-error)))) ;; -------------------------------------------------------------- (defun my-string-to-number (s &rest base) "Converts a string to a integer (or float, if a '.' occurs), relative to a given base (2-36). If no base is given, it is assumed to be to base 10. The digits greater than 9 are assumed to be a,b,c,...z (upper or lowercase). Returns nil if it fails." (let ((l (my-string-to-charlist s)) (base (if (null base) 10 (car base))) (res 0) (digit -1) (minus nil) (shifted nil) (fault nil)) (my-loop-for-e-in-do l (if shifted (setq shifted (/ shifted base))) (cond ((equal e (aref "." 0)) (setq res (* 1.0 res) shifted 1.0)) ((and (= 0 res) (equal e (aref "-" 0))) (setq minus t)) (t (cond ((and (<= 48 e) (<= e 57)) (setq digit (- e 48))) ((and (<= (aref "a" 0) e) (<= e (aref "z" 0))) (setq digit (+ 10 (- e (aref "a" 0))))) ((and (<= (aref "A" 0) e) (<= e (aref "Z" 0))) (setq digit (+ 10 (- e (aref "A" 0))))) (t (setq digit -1))) (if (or (< digit 0) (>= digit base)) (setq fault (if (integerp res) -1 -1.0)) (setq res (+ digit (* base res))))))) (if minus (setq res (- 0 res))) (if fault nil (if shifted (* shifted res) res)))) (defun my-execute-string (string) "Regards string as a function definition and exectues it." (let ((buf (buffer-name)) (pos nil)) (set-buffer "*scratch*") (goto-char (point-max)) (setq pos (point-marker)) (insert (format "\n(defun %s () %s )" *temporary-function-name* string)) (backward-char 1) (eval-defun t) (delete-region pos (point-max)) (set-buffer buf) (funcall *temporary-function-name*))) (defun my-clear-killring () "Makes sure the next kill will not be added to present kill-ring-top. :(( Does not do what I want... (Hopefully never called in an empty write-protected buffer.)" (interactive) (cond ((< (point-marker) (point-max)) **my-lisp-macros-toggle-right-left**) ((> (point-marker) (point-min)) **my-lisp-macros-toggle-left-right**) (t (message "** must do with insertion...") (insert " ") **my-lisp-macros-toggle-left-right** (backward-delete-char 1))) (setq kill-ring (cons "" kill-ring))) (defun regexp-escape-string (string) "Allows to match strings containing braces etc. in regular expressions. Possibly incomplete!" (interactive) (my-replace-char (aref "��" 0) "[]]" (my-replace-char (aref "(" 0) "[(]" (my-replace-char (aref ")" 0) "[)]" (my-replace-char (aref "+" 0) "[+]" (my-replace-char (aref "[" 0) "[[]" (my-replace-char (aref "]" 0) "��" (my-replace-char (aref "*" 0) "\\*" (my-replace-char (aref "." 0) "\\." (my-replace-char (aref "$" 0) "\\$" (my-replace-char (aref "^" 0) "\\^" (my-replace-char (aref "?" 0) "\\." (my-replace-char (aref "\\" 0) "\\\\" string))))))))))))) (defun my-string-to-charlist (s) (let ((res nil)) (my-loop-for-i-from-downto-do (- (length s) 1) 0 (setq res (cons (my-string-pos-char s i) res))) res)) (defun my-charlist-to-string (l) (if (null l) "" (format "%c%s" (car l) (my-charlist-to-string (cdr l))))) (defun my-c-to-string (s) (format "%c" s)) (defun my-string-pos-char (s pos) (aref s pos)) (defun my-is-string-prefix (a b) "Returns true, if the first string can be extended to the second one." (string= (my-substring b 0 (length a)) a)) (defun my-contains-char (s c) (my-member c (my-string-to-charlist s))) (defun my-member (element list &rest cmp) (let ((comparison (if (null cmp) 'equal (car cmp)))) (if (null list) nil (if (funcall comparison (car list) element) t (my-member element (cdr list) comparison))))) (defun my-substring (s from &rest to-rest) "Substring, starts counting at positions 0, optional argument to gives position before truncation, i.e. (my-substring \"abcd\" 1 3) -> \"bc\". (Java convention)." (let ((res nil) (to (if to-rest (min (- (car to-rest) 1) (- (length s) 1)) (- (length s) 1)))) (my-loop-for-i-from-downto-do to from (setq res (cons (aref s i) res))) (eval (cons 'scon (mapcar 'my-c-to-string res))))) (defun my-substring-upto-char (s c) "Returns a string until the first occurence of a char (inclusive)" (let ((tmp nil) (res nil)) (my-loop-for-i-from-to-do 0 (- (length s) 1) (setq tmp (cons (my-string-pos-char s i) tmp)) (if (equal (my-string-pos-char s i) c) (setq res tmp i (length s)))) (eval (cons 'scon (mapcar 'my-c-to-string (reverse res)))))) (defun get-this-word-mute () (interactive) (let ((origin (point-marker)) (start nil)) (search-backward-regexp "\$\$\\|^\\|\\<\$") ;; (forward-char 1) (setq start (point-marker)) (search-forward-regexp "\$ \\|\r\\|\n\\|\t\\|$\$") (backward-char 1) (kill-ring-save start (point-marker)) (goto-char origin)) (format "%s" (car kill-ring))) (defun my-replace-char (orig new string) "Replace character by other character (i.e. ASCII number) or string." (interactive) ; (if (stringp new) ; (message (format "%s:-->%s<--" "replacing in" new)) ; (message "FAIL")) (let ((charlist (my-string-to-charlist string)) (res nil) (new-list (cond ((stringp new) (list new)) ; (reverse (my-string-to-charlist new))) ((integerp new) (list (format "%c" new))) (t "?")))) (while (not (null charlist)) (setq res (if (eq orig (car charlist)) (append new-list res) (cons (format "%c" (car charlist)) res))) (setq charlist (cdr charlist))) (eval (cons 'scon (reverse res))))) (defun message-save (m) (interactive) (setq *last-saved-message* m) (message m)) (defun redisplay-saved-message () (interactive) (message *last-saved-message*)) (defun my-get-filename-suffix (&rest filename) "Return everything *after* the last dot in filename as a string. If a version is given, strip it off first." (let* ((fn (if (null filename) (get-current-filename) (car filename))) (s (my-reverse (my-string-to-charlist fn))) (res nil) (is-dotted nil)) (while (and (> (length s) 0)) (if (equal (car s) (aref "." 0)) (setq is-dotted t s nil) (my-push (car s) res)) (setq s (cdr s))) (if is-dotted (stripoff-version-if-present (my-charlist-to-string res)) ""))) ;;; ////////////////////////////////////////////////////////////////// ;;; [4] Ordinary Text Manipulation ;;; ////////////////////////////////////////////////////////////////// ;;; ////////////////////////////////////////////// ;;; [4.1] Removing and Copying ;;; ////////////////////////////////////////////// (defun backward-delete-word () "kill word, but overwrite first in kill-ring with old value. (For some reason, this is NOT provided by simple.) " (interactive) (let ((save (car kill-ring))) ;; (message (format "saved: %s" save)) (backward-kill-word 1) (setq kill-ring (cons save (cdr kill-ring))))) (defun copy-last-line () (interactive) (let ((point1 nil) (col (current-column))) (previous-line 1) (beginning-of-line) (setq point1 (point-marker)) (end-of-line) (kill-ring-save point1 (point-marker)) (next-line 1) (beginning-of-line) (yank) (insert "\n") ;; (previous-line 1) (move-to-column col) )) (defun copy-this-line () (interactive) (kill-new "" t) (let ((point1 nil) (point2 nil) (mx nil) (col (current-column)) (str "") (new-str "") (num 0)) (beginning-of-line) (setq point1 (point-marker)) (end-of-line) (kill-ring-save point1 (point-marker)) (next-line 1) (beginning-of-line) (setq point2 (point-marker)) (insert (format "%s\n" (car kill-ring))) (previous-line 1) (move-to-column col) (if *auto-all-count-when-copy-this-line* (progn (setq str (kill-number-at-point)) (setq num (my-string-to-number str)) (if (and (> (length str) 0) (>= num 0)) (if *auto-all-count-when-copy-this-line* (progn (setq new-str (format "%d" (+ 1 num))) (insert str) (beginning-of-line) (my-replace-regexp-in-this-line (format "[^0123456789\n]%s[^0123456789]" str) new-str 1 1) ;;(move-to-column col) ) (setq new-str (format "%d" (+ 1 num))) (insert new-str)) (yank)))) (goto-char point2) (move-to-column col))) ;; -- (defun add-copy-last-complex-statement (a-mode-name function-name) "Make an entry; If copy-last-complex-statement is called in this mode, provide a function name to be executed. " (let ((clean (my-loop-for-e-in-append *alist-for-copy-last-complex-statement* (if (string= (car e) a-mode-name) nil (list e))))) (setq *alist-for-copy-last-complex-statement* (cons (cons a-mode-name function-name) clean)))) (defun copy-last-complex-statement () (interactive) (message (format "** looking for mode name >>%s<<..." mode-name)) (let ((hit (assoc mode-name *alist-for-copy-last-complex-statement*))) (if hit (progn (funcall (cdr hit)) (redisplay-saved-message)) (message "** not implemented for this mode")))) ;; -- for lisp mode: -------------------------------------------- (defun copy-last-complex-emacs-lisp-statement () "Goes back to surrounding parentheses and copies the statements if finds." (interactive) (let ((pos (point-marker)) (fail nil) (start nil) (end nil)) (if (and (search-backward ")" (point-min) t) (my-backward-find-matching-parentheses)) (progn (backward-char 1) (setq start (point-marker)) (forward-char 1) (if (my-forward-find-matching-parentheses) (setq end (point-marker)) (setq fail t))) (setq fail t)) (goto-char pos) (if fail (message "** Did not find closed structure to insert") (progn (kill-ring-save start end) (indent-for-tab-command) (insert (car kill-ring)) (goto-char pos) (message "** inserted."))))) ;; -- for ksh mode --------------------------------------------------------- (defun copy-last-complex-ksh-statement () "Tries to find a previous control pattern and copies it into place. Likely to do nonsense in some cases." (interactive) (let* ((pos (point-marker)) (tmp nil) (all-chars "[\n\t\r\f -~]") (matches nil)) ;; -- find possible matches ------------------------------------------- (if ;; -- function structure ------------------------------- (and (search-backward-regexp "\\bfunction\\b[a-zA-Z_\t\n\r ]*{" (point-min) t) (progn (setq tmp (point-marker)) (search-forward "{") (my-forward-find-matching-brace t)) (<= (point-marker) pos)) (my-push (list tmp (point-marker)) matches)) (goto-char pos) (if ;; -- while -------------------------------------------- (search-backward-regexp (format "\\bwhile\\b%s*\\bdo\\b%s*\\bdone\\b" all-chars all-chars) (point-min) t) (setq matches (cons (list (match-beginning 0) (match-end 0)) matches))) (goto-char pos) (if ;; -- for -------------------------------------------- (search-backward-regexp (format "\\bfor\\b%s*\\bdo\\b%s*\\bdone\\b" all-chars all-chars) (point-min) t) (setq matches (cons (list (match-beginning 0) (match-end 0)) matches))) (goto-char pos) (if ;; -- if ----------------------------------------------- (search-backward-regexp (format "\\bif\\b%s*\\bthen\\b%s*\\bfi\\b" all-chars all-chars) (point-min) t) (setq matches (cons (list (match-beginning 0) (match-end 0)) matches))) (goto-char pos) ;; -------------------------------------------------------------------- ;; -- take match with highest end ------------------------------------- (message (format "** found %d matches." (length matches))) (if matches (progn (goto-char pos) (eval (cons 'kill-ring-save (car (sort matches #'(lambda (x y) (message (format "compare " x y)) (> (cadr x) (cadr y))))))) (insert (car kill-ring)) (goto-char pos)) (message "** Did not find matching structure to insert")))) (add-copy-last-complex-statement "Emacs-Lisp" 'copy-last-complex-emacs-lisp-statement) (add-copy-last-complex-statement "Lisp" 'copy-last-complex-emacs-lisp-statement) (add-copy-last-complex-statement "Ksh" 'copy-last-complex-ksh-statement) (add-copy-last-complex-statement "Shell-script" 'copy-last-complex-ksh-statement) ;;; //////////////////////////////////// ;;; [4.1.1] Cutting and Killing ;;; //////////////////////////////////// (defun kill-rest-of-buffer () "Kill and insert the rest of the buffer (starting at point) in kill ring." (interactive) (kill-region (point-marker) (point-max))) (defun insert-some-spaces (&rest number) "Does insert some space at point, by default 8." (interactive) (let ((n (if (null number) 6 (car number)))) (my-loop-for-i-from-to-do 1 n (insert " ")))) ;;; //////////////////////////////////////// ;;; [4.1.2] Positioning ;;; //////////////////////////////////////// (defun backward-to-last-capitalized-wordstart () "Positions point either at the last word-start or where the last *capitalized* partial word begins, whatever comes first." (interactive) (let ((pos (point-marker)) (lim nil) (saved-case-fold-search case-fold-search)) (backward-word 1) (setq lim (point-marker)) (goto-char pos) (setq case-fold-search nil) (backward-char 1) (if (search-backward-regexp "[A-Z]" lim t) nil (goto-char lim)) (setq case-fold-search saved-case-fold-search))) (defun forward-to-next-capitalized-wordstart () "Positions point either at the next word-start or where the next *capitalized* partial word begins, whatever comes first." (interactive) (let ((pos (point-marker)) (lim nil) (saved-case-fold-search case-fold-search)) (forward-word 1) (setq lim (point-marker)) (goto-char pos) (setq case-fold-search nil) (forward-char 1) (if (search-forward-regexp "[A-Z]" lim t) (backward-char 1) (goto-char lim)) (setq case-fold-search saved-case-fold-search))) ;;; ///////////////////////// ;;; [4.1.3] Simple Text Replacement ;;; ///////////////////////// (defun my-replace-string-in-this-line (&rest args) "Replaces occurrences of STRING from point until the end of the line. If no list of two arguments is provided, they are queried interactively. RETURNS the number of matches encountered (as an integer). " (interactive) (let ((from-string (if (null args) (read-input "FROM: ") (car args))) (to-string (if (null (cdr args)) (read-input "TO: ") (car (cdr args)))) (pos (point-marker)) (eol nil) (tmp nil) (count 0) (notdone t)) ;; (message (format "Replacing >>%s<< by >>%s<< in line." from-string to-string)) (while notdone (setq tmp (point-marker)) (end-of-line) (setq eol (point-marker)) (goto-char tmp) (if (search-forward from-string eol t) (progn (setq count (+ count 1)) (setq tmp (point-marker)) (search-backward from-string) (delete-region (point-marker) tmp) (insert to-string)) (setq notdone nil))) (goto-char pos) count)) (defun my-replace-regexp-in-this-line (&rest args) "Replaces occurrences of regexp from point until the end of the line. Argument list: FROM (regexp) TO (string) front-offset (integer) back-offset (integer) front-offset determines, how many characters of the matched Regexp at the beginning should *not* be replaced. back-offset determines, how many characters of the matched Regexp at the end should *not* be replaced. If no list of two arguments is provided, they are queried interactively. If the last two arguments are not given, they are assumed to be 0. RETURNS the number of matches encountered (as an integer)." (interactive) (let ((from-string (if (null args) (read-input "FROM (regexp): ") (car args))) (to-string (if (null (cdr args)) (read-input "TO: ") (car (cdr args)))) (front-offset (if (null (cddr args)) 0 (car (cddr args)))) (back-offset (if (null (cddr (cdr args))) 0 (car (cddr (cdr args))))) (pos (point-marker)) (eol nil) (tmp nil) (count 0) (notdone t)) ;; (message (format "Replacing regexp >>%s<< by >>%s<< in line." from-string to-string)) (while notdone (setq tmp (point-marker)) (end-of-line)(forward-char 1) (setq eol (point-marker)) (goto-char tmp) (if (search-forward-regexp from-string eol t) (progn (setq count (+ count 1)) (backward-char back-offset) (setq tmp (point-marker)) (forward-char back-offset) (search-backward-regexp from-string) (forward-char front-offset) (kill-region (point-marker) tmp) (message (format "Matched: >>%s<<" (car kill-ring))) (insert to-string)) (setq notdone nil))) (goto-char pos) count)) (defun determine-endline-fix (filename-suffix) "returns number of endline characters to remove; null if none." (cond ((member filename-suffix *listof-html-type-suffixes*) 5) ((member filename-suffix *listof-sml-type-suffixes*) 3) (t nil))) (defun remove-html-comment-end () "Deletes the closing comment of an html line. Sanity checks, whether this closing really exists." (interactive) (let ((pos (point-marker)) (tmp nil)) (end-of-line) (setq tmp (point-marker)) (beginning-of-line) (if (search-forward-regexp "-->[ \t]*$" tmp t) (progn (replace-match "") (search-backward-regexp "[^\t ]") (forward-char 1) (kill-line 1) (insert "\n"))) (goto-char pos))) (defun remove-sml-comment-end () "Deletes the closing comment of an sml line. Sanity checks, whether this closing really exists." (interactive) (let ((pos (point-marker)) (tmp nil)) (end-of-line) (setq tmp (point-marker)) (beginning-of-line) (if (search-forward-regexp "\*)[ \t]*$" tmp t) (progn (replace-match "") (search-backward-regexp "[^\t ]") (forward-char 1) (kill-line 1) (insert "\n"))) (goto-char pos))) ;;; ////////////////////////////////////////////// ;;; [4.2] Text Manipulation: Snip ;;; ////////////////////////////////////////////// (defun snip-out-region () "Deletes a region and inserts information, how may lines are missing. Does not insert in kill-ring (for the deleted text is likely to be big)." (interactive) (if mark-active (let* ((from nil) (to nil) (tmp nil) (count 0) (history 0) (snip-starter " >>>---- SNIP: deleted ") (snip-starter-pattern " \$>>>\\|<<<\$---- SNIP: deleted ") ) (setq to (point-marker)) (exchange-point-and-mark) (setq from (point-marker)) (if (< to from) (progn (setq tmp from) (setq from to) (setq to tmp))) (setq count (my-substring-upto-char (my-substring (count-lines-region from to) 11 101) (aref "l" 0))) (setq count (my-substring count 0 (- (length count) 2))) (message (format "snipped -->%s<-- lines" count)) (setq count (my-string-to-number count)) (goto-char from) ;;; collect values from older snip-lets... (while (search-forward-regexp snip-starter-pattern to t) (forward-char 1) (setq history (+ history (my-string-to-number (get-this-word-mute))))) (delete-region from to) (insert (format "\n%s%d lines ------------- %s ---->>>\n" snip-starter (+ history count) (format-time-string "%H:%M %d %b %Y")))))) (defun replicate-char (c n) (let ((res nil)) (my-loop-for-i-from-to-do 1 n (my-push c res)) (my-charlist-to-string res))) (defun snap-include-file (filename) "Insert contents of file FILENAME into buffer after point. Set mark after the inserted text. It surrounds the included file by dashed lines and gives a time stamp." (interactive "*fInsert file: ") (let* ((goal 70) (name (stripoff-path-from-filename filename)) (time (format-time-string "%H:%M %d %b %Y")) (pos (point-marker))) (insert (format "-- %s %s\n" name (replicate-char (aref "-" 0) (- goal 4 (length name))))) (setq pos (point-marker)) (insert (format "-- end of %s %s %s --\n" name (replicate-char (aref "-" 0) (- goal 15 (length name) (length time))) time)) (goto-char pos) (insert-file-contents filename))) (defun remove-nl-in-region () "Deletes all newlines in region." (interactive) (if mark-active (let* ((from nil) (to nil) (tmp nil) ) (setq to (point-marker)) (exchange-point-and-mark) (setq from (point-marker)) (if (> from to) (progn (setq tmp from) (setq from to) (setq to tmp))) (goto-char from) (while (search-forward-regexp "[\n\r]" to t) (replace-match ""))))) ;;; ////////////////////////////////////////////// ;;; [4.3] Headings & Captions ;;; ////////////////////////////////////////////// (defun text-insert-huge-headline () (interactive) (text-insert-headline "70")) (defun text-insert-big-headline () (interactive) (text-insert-headline "50")) (defun text-insert-medium-headline () (interactive) (text-insert-headline "40")) (defun text-insert-small-headline () (interactive) (text-insert-headline "25")) (defun text-insert-headline (length) "Insert a (textual) headline beginning with default commenters; The length refers to the COLUMN where the headline stops (after indentation). If no length is provided, it is queried." (interactive "sHeadline Length: ") (let* ((c2 (get-file-continuation-comment-char)) (start (get-file-start-line-comment)) (line-terminator (get-line-terminator-lambdaexpression)) (len (my-string-to-number length)) (tmp nil) (tmp2 nil) (indented-line-start-pattern (format "^[\t ]*%s[ \t]+" start)) (indent-line-correctly (get-indent-line-correctly-lambdaexpression))) (if *allow-headline-recomputation* (progn (previous-line 1) ;; -- check line before ------------------------------- (end-of-line) (setq tmp (point-marker)) (beginning-of-line) (if (search-forward-regexp indented-line-start-pattern tmp t) (progn (beginning-of-line) (kill-line 1)) (next-line 1)) ;; -- check line itself ------------------------------- (end-of-line) (setq tmp (point-marker)) (beginning-of-line) (setq tmp2 (point-marker)) (if (search-forward-regexp indented-line-start-pattern tmp t) (progn (kill-region tmp2 (point-marker)) (cond ((member (my-get-filename-suffix) *listof-html-type-suffixes*) (remove-html-comment-end)) ((member (my-get-filename-suffix) *listof-sml-type-suffixes*) (remove-sml-comment-end)) ))) ;; -- force next line ----------------------- (end-of-line) (if (< (point-marker) (point-max)) (next-line 1) (insert "\n")) ;; -- check following line ---------------------------- (end-of-line) (setq tmp (point-marker)) (beginning-of-line) (if (search-forward-regexp indented-line-start-pattern tmp t) (progn (beginning-of-line) (kill-line 1))) ;; -- adjust ------------------------------------------ (previous-line 1))) ;; -- fix html length -------------------------------------------------- (if (member (my-get-filename-suffix (get-current-filename)) *listof-html-type-suffixes*) (setq len (- len 5))) ;; -- fix sml length --------------------------------------------------- (if (member (my-get-filename-suffix (get-current-filename)) *listof-sml-type-suffixes*) (setq len (- len 2))) ;; -- insert headline -------------------------------------------------- (next-line 1) (beginning-of-line) (insert "\n") (previous-line 3) (end-of-line) (insert "\n") (beginning-of-line) (if *headline-indent-before-inserting* (funcall indent-line-correctly)) (insert (format "%s " start)) ;; -- line 1 ------------------ (while (< (current-column) len) (insert c2)) (funcall line-terminator (+ len 5))(delete-char 1) (if *headline-indent-before-inserting* (funcall indent-line-correctly)) (insert (format "%s " start)) ;; -- line 2 ------------------ (funcall line-terminator (+ len 5))(delete-char 1) (beginning-of-line) (if *headline-indent-before-inserting* (funcall indent-line-correctly)) (insert (format "%s " start)) ;; -- line 3 ------------------ (while (< (current-column) len) (insert c2)) (funcall line-terminator (+ len 5)) (previous-line 3)(funcall indent-line-correctly) (next-line 1)(funcall indent-line-correctly) (next-line 1)(funcall indent-line-correctly) (end-of-line) (kill-line 1) (previous-line 1) (beginning-of-line) (search-forward-regexp "[^ \t]") (search-forward " ") (forward-char 0))) ;;; ////////////////////////////////////////////// ;;; [4.4] Semaphores (separating-lines) ;;; ////////////////////////////////////////////// (defun text-insert-huge-semaphore () (interactive) (text-insert-semaphore "76")) (defun text-insert-big-semaphore () (interactive) (text-insert-semaphore "65")) (defun text-insert-medium-semaphore () (interactive) (text-insert-semaphore "55")) (defun text-insert-semaphore (length) "Insert a one-line separator comment, augmented with some information" (interactive "sSemaphore Length: ") (let* ((c2 (get-file-continuation-comment-char)) (c3 (get-file-semaphore-comment-char)) (start (get-file-intermediate-line-comment)) (line-terminator (get-line-terminator-lambdaexpression)) (len (my-string-to-number length)) (tmp nil) (indent-line-correctly (get-indent-line-correctly-lambdaexpression)) (nonempty-text t) (semaphore-starter (format "%s %s%s" start c3 c3)) (semaphore-continue-regexp (format "[^%s \t]" c3)) (needs-endline-fix (determine-endline-fix (my-get-filename-suffix (get-current-filename))))) ;; -- fix html length -------------------------------------------------- (if needs-endline-fix (setq len (- len needs-endline-fix))) ;; -- start ------------------------------------------------------------ (end-of-line) (setq tmp (point-marker)) (beginning-of-line) (if (or (this-is-end-of-line) (null (search-forward-regexp "[^ \t]" tmp t))) (setq nonempty-text nil)) (goto-char tmp)(beginning-of-line) (if (null nonempty-text) (kill-region (point-marker) tmp)) (if (and *allow-semaphore-recomputation* (search-forward semaphore-starter tmp t)) (progn ;; -- remove old semaphore ------------- (insert "\n") (previous-line 1) (beginning-of-line) (insert "X") (kill-line 1) (end-of-line) (setq tmp (point-marker)) (search-backward-regexp semaphore-continue-regexp) (forward-char 1) (kill-region (point-marker) tmp) (beginning-of-line) (delete-char 1) (if (this-is-end-of-line) (setq nonempty-text nil)))) ;; -- fix html ending ---------------------------- (if needs-endline-fix (progn (cond ((member (my-get-filename-suffix (get-current-filename)) *listof-html-type-suffixes*) (remove-html-comment-end)) ((member (my-get-filename-suffix (get-current-filename)) *listof-sml-type-suffixes*) (remove-sml-comment-end)) (t (error "Endline fix set in un-handled mode."))) (end-of-line) (setq tmp (point-marker)) (beginning-of-line) (if (search-forward-regexp "[\t ~]*$" tmp t) (replace-match "")))) ;; -- insert semaphore ---------------------------- (beginning-of-line) (if *semaphore-indent-before-inserting* (funcall indent-line-correctly)) (insert semaphore-starter) (if nonempty-text (progn (delete-until-next-nonspace) (insert " "))) (end-of-line) (if nonempty-text (progn (setq tmp (point-marker)) (goto-previous-non-whitespace)(forward-char 1) (kill-ring-save (point-marker) tmp) (insert " "))) (funcall indent-line-correctly) (while (< (current-column) len) (insert c3)) (funcall line-terminator (- len 5)) (if (< (point-marker) (point-max)) (delete-char 1)) (previous-line 1) (beginning-of-line) (search-forward semaphore-starter) )) ;;; ////////////////////////////////////////////// ;;; [4.5] End-line-comments ;;; ////////////////////////////////////////////// (defun text-insert-huge-end-line-comment () (interactive) (text-insert-end-line-comment "76")) (defun text-insert-big-end-line-comment () (interactive) (text-insert-end-line-comment "65")) (defun text-insert-medium-end-line-comment () (interactive) (text-insert-end-line-comment "55")) (defun text-insert-end-line-comment (length) "Insert a comment, starting here and reaching till the end of line, featuring at least two -s and continuing with '-'. If text is written after this point, it is included in the comment." (interactive "sUp to Line: ") (let* ((c2 (get-file-continuation-comment-char)) (c3 (get-file-semaphore-comment-char)) (start (get-file-intermediate-line-comment)) (line-terminator (get-line-terminator-lambdaexpression)) (len (my-string-to-number length)) (pos (point-marker)) (hits 0) (tmp nil) (hit-backwards) (indent-line-correctly (get-indent-line-correctly-lambdaexpression)) (nonempty-text (null (this-is-end-of-line))) (end-line-comment-starter (format "%s %s%s" start c3 c3)) (end-line-comment-rest-regexp (format "[%s]*[ \t]*$" c3)) (needs-endline-fix (determine-endline-fix (my-get-filename-suffix (get-current-filename))))) (setq kill-ring (cons "" kill-ring)) ;; -- fix html/sml length ---------------------------------------------- (if needs-endline-fix (setq len (- len needs-endline-fix))) ;; -- test for exiting end-line-comment -------------------------------- (if *allow-semaphore-recomputation* (progn (end-of-line) (if (>= (point-marker) (point-max)) ;; -- fix end-of-buffer (progn (insert "\n") (backward-char 1))) ;; ------------------------------------------------ (forward-char 1) (setq tmp (point-marker))(backward-char 1) (beginning-of-line) (if (search-forward end-line-comment-starter tmp t) ;; -- Kill old comment-padding ---------- (progn (delete-region (match-beginning 0) (point-marker)) (delete-char 1 t) (if (string= (car kill-ring) " " ) (setq nonempty-text t) (insert (car kill-ring))) ;;(backward-char 1) (setq pos (point-marker)) (if (search-forward-regexp end-line-comment-rest-regexp tmp t) (delete-region (match-beginning 0) (point-marker))))))) (goto-char pos) ;; -- insert as usual ----------------------------- (insert end-line-comment-starter) (if (and nonempty-text (= hits 0)) (insert " ")) (funcall indent-line-correctly) (end-of-line) (if nonempty-text ;; -- insert space, if no space is already there ----- (progn (backward-delete-char 1 t) (insert (car kill-ring)) (if (not (string= " " (car kill-ring))) (insert " ")))) (while (< (current-column) len) (insert c3)) (funcall line-terminator (- len 5)) (if (< (point-marker) (point-max)) (delete-char 1)) (previous-line 1) (beginning-of-line) (search-forward end-line-comment-starter) (forward-char 1))) ;;; ////////////////////////////////////////////////////////////////// ;;; [5] Disclaimer ;;; ////////////////////////////////////////////////////////////////// (defun get-file-startline-comment-char (&rest filename) (let* ((fn (if (null filename) (get-current-filename) (car filename))) (suffix (my-get-filename-suffix fn))) (cond ((member suffix *listof-lisp-type-suffixes*) ";") ((member suffix *listof-c-type-suffixes*) "/") ((member suffix *listof-tex-type-suffixes*) "%") ;; -- DUMMIES --------------------------------------------- ((member suffix *listof-html-type-suffixes*) "~") ((member suffix *listof-sml-type-suffixes*) "-") ;; -- Prefixes -------------------------------------------- ((some-in-list (list 'lambda '(x) (list 'my-is-string-prefix 'x (list 'stripoff-path-from-filename fn))) *listof-xmodmap-type-prefixes*) "!") ;; -- now rest -------------------------------------------- ((or (string= suffix "java") (string= suffix "jde")) "/") ((string= mode-name "Lisp") ";") ((string= mode-name "PVS") "%") ((string= suffix "dat") "%") ((string= suffix "cwb") "*") ((string= suffix "ta") "/") ((my-string-ends-with fn ".java.override") "/") (t "#")))) (defun pattern-get-file-startline-comment-char (&rest filename) "Wraps \"%\" in get-file-startline-comment-char, to include in format string." (let ((str (eval (cons 'get-file-startline-comment-char filename)))) (cond ((string= str "%") "%%%%") (t str)))) (defun get-file-start-line-comment (&rest filename) (let* ((fn (if (null filename) (get-current-filename) (car filename))) (commenter (get-file-startline-comment-char fn))) (cond ((or (string= mode-name "Emacs-Lisp") (string= mode-name "Lisp")) (format "%s%s%s" commenter commenter commenter)) ((member (my-get-filename-suffix fn) *listof-sml-type-suffixes*) "(*") ((member (my-get-filename-suffix fn) *listof-html-type-suffixes*) "") ;; -------------------------------------------------------- ((member suffix *listof-sml-type-suffixes*) "*)") ;; ------------------------------------------------------------------- (t "")))) (defun get-line-terminator-lambdaexpression (&rest filename-suffix) "Return an evaluate-able lambda-expression that inserts a proper line termination (dependent on the file type). Call this with (funcall ....)." (let ((suffix (if filename-suffix (car filename-suffix) (my-get-filename-suffix)))) (cond ((member suffix *listof-html-type-suffixes*) (list 'lambda (list '&rest 'preferred-column) (list 'let (list (list 'pc (list 'if (list 'null 'preferred-column) (list '- '*usual-edit-width* 12) (list 'car 'preferred-column)))) (list 'end-of-line-atleast-in-column 'pc) (list 'insert " -->\n")))) ((member suffix *listof-sml-type-suffixes*) (list 'lambda (list '&rest 'preferred-column) (list 'let (list (list 'pc (list 'if (list 'null 'preferred-column) (list '- '*usual-edit-width* 10) (list 'car 'preferred-column)))) (list 'end-of-line-atleast-in-column 'pc) (list 'insert " *)\n")))) (t '(lambda (&rest dummy) (end-of-line) (insert "\n")))))) (defun get-indent-line-correctly-lambdaexpression () "Return an evaluate-able lambda-expression that executes a proper line indentation (dependent on the file type). Call this with (funcall ....)." (let* ((fn (get-current-filename)) (suffix (my-get-filename-suffix fn))) (cond ((or (string= suffix "java") (string= suffix "jde") (my-string-ends-with fn ".java.override") ) #'c-indent-command) ((or (member suffix *listof-c-type-suffixes*) (string= mode-name "C++")) #'c-indent-command) ((member suffix *listof-lisp-type-suffixes*) #'indent-for-tab-command) ((member suffix *listof-html-type-suffixes*) #'html-helper-indent-command) ((member suffix *listof-sml-type-suffixes*) #'sml-indent-line) ((string= mode-name "Ksh") #'ksh-indent-command) (t #'(lambda ()))))) (defun get-escape-character (&rest filename) (let* ((fn (if (null filename) (get-current-filename) (car filename))) (suffix (my-get-filename-suffix fn))) (cond ((string= suffix "bib") "$") ((string= suffix "masterbib") "$") ((string= (buffer-name-without-version) "bib.tpl") "$") (t "@")))) (defun insert-last-found-synopsis (line-start) "Browses buffer list, searches for synopsis. If found, strips of local line-starts and (possibly) \"-->$\" ends. Then inserts the synopsis in the current buffer, using line-start and the line-terminator function Returns nil, if nothing was found." (let* ((this-buffer (current-buffer)) (last-synopsis nil) (continue-synopsis-pattern "") (tmp nil) (local-line-start "") (synopsis-pattern "") (stripoff-end-pattern "-->$") (line-terminator (get-line-terminator-lambdaexpression)) (list (buffer-list))) (save-excursion (my-loop-for-e-in-do (cdr list) (if (null last-synopsis) (progn (set-buffer e) ;;(switch-to-buffer e) (goto-char (point-min)) (message (buffer-name)) (setq local-line-start (pattern-get-file-startline-comment-char)) ;; (message local-line-start) (setq synopsis-pattern (format "^[%s]+[ ]+Synopsis:" local-line-start)) ;; (message synopsis-pattern) (if (search-forward-regexp synopsis-pattern (point-max) t) (progn ;; -- parse synopsis ------- ;;(message (format "** Synopsis found in %s" (buffer-name))) (forward-line 1) (setq continue-synopsis-pattern (format "^[%s]+ [^@%s]" local-line-start (pattern-get-file-continuation-comment-char))) ;;(message "try") ;;(message continue-synopsis-pattern) (while (search-forward-regexp continue-synopsis-pattern (point-end-of-this-line) t) (beginning-of-line) (goto-next-whitespace) (setq tmp (point-marker)) (end-of-line) (search-backward-regexp stripoff-end-pattern (point-beginning-of-this-line) t) (kill-ring-save tmp (point-marker)) (setq last-synopsis (append last-synopsis (list (car kill-ring)))) (forward-line 1)))))))) (switch-to-buffer this-buffer) (if last-synopsis (progn (my-loop-for-e-in-do last-synopsis (insert (format "%s%s" local-line-start e)) (funcall line-terminator)) t) nil))) (defun insert-disclaimer () (interactive) (let ((save-case-fold-search case-fold-search) (orig-pos (point-marker))) (setq case-fold-search t) (if (or *allow-new-disclaimer-if-version-exists* (let* ((current-pos (point-marker)) (res nil) (escape-string (get-escape-character)) (pattern (scon escape-string "version"))) (goto-char (point-min)) (setq res (search-forward-regexp pattern (point-max) t)) (goto-char current-pos) (null res))) (let* ((commenter (get-file-startline-comment-char)) (escape-string (get-escape-character)) (suffix (my-get-filename-suffix)) (used-email-address (cond ((string= suffix "bib") (my-replace-char (aref "@" 0) "(a)" *my-email-address*)) (t *my-email-address*))) (preamble (cond ((string= suffix "bash") (format "#!%s\n" *bash-program-call*)) ((string= suffix "perl") (format "#!%s\n" *perl-program-call*)) ((string= suffix "pl") (format "#!%s\n" *perl-program-call*)) ((string= suffix "xml") (format "%s\n" *usual-xml-doc-type*)) ((string= suffix "dtd") (format "%s\n" *usual-xml-doc-type*)) ((string= suffix "java") (format "%s\n" *usual-java-preamble*)) ((my-string-ends-with (stripoff-version-if-present (buffer-name)) "java.override") (format "%s\n" *usual-java-preamble*)) ((member suffix *listof-html-type-suffixes*) (format "%s\n" *usual-html-doc-type*)) ((string= mode-name "C++") (format "%s\n" *usual-c++-preamble*)) (t "") )) (start-line (get-file-start-line-comment)) (comment-line (format "%s %s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s" start-line commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter commenter)) (start-pos nil) (line-terminator (get-line-terminator-lambdaexpression))) (goto-char (point-min)) (insert "\n") (goto-char (point-min)) ;; (message (format "%s" (get-current-filename))) (insert preamble) (insert (format "%s" comment-line))(funcall line-terminator) (insert (format "%s " start-line)) (setq start-pos (point-marker))(funcall line-terminator) (insert (format "%s " start-line)) (funcall line-terminator) (insert (format "%s Synopsis:" start-line)) (funcall line-terminator) (or (and *disclaimer-inherit-synopsis* (insert-last-found-synopsis start-line)) (insert (format "%s" start-line)) (funcall line-terminator)) (insert (format "%s" comment-line)) (funcall line-terminator) (insert (format "%s %sFILE: %s" start-line escape-string (stripoff-path-from-filename (get-current-filename)))) (funcall line-terminator) (insert (format "%s %sPLACE: %s" start-line escape-string *default-local-place*))(funcall line-terminator) (insert (format "%s %sFORMAT: %s" start-line escape-string (cond ((string= mode-name "Emacs-Lisp") "emacs lisp") ((string= mode-name "Lisp") "lisp") ((string= mode-name "C") "plain C") ((string= mode-name "C++") "plain C++") ((string= mode-name "TeX") "LaTeX 2e") ((string= mode-name "LaTeX") "LaTeX 2e") ((string= mode-name "PVS") "Prototype Verification System (PVS)") ((string= suffix "cl") "lisp [Allegro Common Lisp]") ((string= suffix "bash") "Bash Script") ((string= suffix "perl") "Perl Script") ((string= suffix "html") "HTML") ((string= suffix "ml") "(Standard) ML") ((string= suffix "xml") "XML") ((string= suffix "dtd") "XML Document Type Definition") ((string= suffix "bib") "BibTeX") ((string= suffix "cwb") "Concurrency Workbench Specification File") ((string= suffix "ta") "Timed Automaton (verifyta style)") ((> (length (my-get-filename-suffix)) 0) (my-get-filename-suffix)) (t "plain text")) )) (funcall line-terminator) (insert (format "%s %sAUTHOR: %s <%s>" start-line escape-string *my-full-name* used-email-address)) (funcall line-terminator) (insert (format "%s %sBEGUN: %s" start-line escape-string (current-time-string))) (funcall line-terminator) (insert (format "%s %sVERSION: %s" start-line escape-string (current-time-string))) (funcall line-terminator) (insert (format "%s" comment-line)) (funcall line-terminator) (insert (format "%s " start-line)) (funcall line-terminator) (goto-char start-pos) ) (update-this-file-version)) (setq case-fold-search save-case-fold-search) (goto-char orig-pos))) (defun update-version-respecting-number () "Write Date, but preserver Strings standing between point and previous date or, if no date is given, end of line.\n Returns the complete version string." (interactive) (let ((cur-point (point-marker)) (line-terminator (get-line-terminator-lambdaexpression)) (end-point nil)) (end-of-line) (setq end-point (point-marker)) (goto-char cur-point) ;; -- search for old date ----------------------------------- (if (search-forward-regexp *start-of-time-regexp* end-point t) (search-backward-regexp *start-of-time-regexp*) (progn (end-of-line) (insert " ") (backward-char 1))) ;; ---------------------------------------------------------- (kill-line 1) (insert (format "%s\n" (current-time-string))) (backward-char 1) (funcall line-terminator) (delete-char 1) ;; -- return version string --------------------------------- (kill-ring-save cur-point (point-marker)) (car kill-ring))) (defun update-this-file-version () "Updates the file version and place (if *update-place-if-existent* is t); Assumes that there is already some @version tag." (interactive) (let* ((pos (point-marker)) (aux nil) (count 0) (allow-multiple-replaces (and *allow-multiple-version-replacements* (not (string= (stripoff-path-from-filename (get-current-filename)) "tocedit.el")))) (allow-next-replace t) (save-case-fold-search case-fold-search) (escape-string (get-escape-character)) (pattern (scon escape-string "version")) (place-pattern (scon escape-string "place")) (file-pattern (scon escape-string "file")) (first-version-expression nil) (line-terminator (get-line-terminator-lambdaexpression)) ) (setq case-fold-search t) (goto-char (point-min)) ;;; -- PLACE ------------------------------ (if *update-place-if-existent* (if (search-forward place-pattern (point-max) t) (progn (search-backward place-pattern) (kill-line 1) (insert (format "%sPLACE: %s\n" escape-string *default-local-place*)) (previous-line 1) (funcall line-terminator) (backward-delete-char 1)) ;; --- place not found... ---- (if *insert-place-if-not-existent* (progn (goto-char (point-min)) (if (search-forward file-pattern (point-max) t) (progn (next-line 1) (beginning-of-line) (insert (format "%s %sPLACE: %s\n" (get-file-start-line-comment) escape-string *default-local-place*)) (previous-line 1) (funcall line-terminator) (backward-delete-char 1) ) (message "** Don't know where to insert PLACE, sorry.") ))))) ;; -- LAST -------------------------------------------------- (if *update-last-if-existent* (update-last-user-if-mark-present)) ;; ---------------------------------------------------------- (goto-char (point-min)) (while (and (search-forward pattern (point-max) t) allow-next-replace) (setq allow-next-replace allow-multiple-replaces) (goto-next-whitespace) (goto-next-non-whitespace) (if (and *allow-multiple-version-replacements* *propagate-first-version-occurrence-to-other* first-version-expression) (progn ;; -- insert existing one ---------------------- (kill-line 1) (message (format "** overwriting with \"%s\"" first-version-expression)) (insert first-version-expression) (funcall line-terminator) ) (progn ;; -- else: get existing one ------------------- (setq first-version-expression (update-version-respecting-number)))) (setq count (+ 1 count))) ;; ---------------------------------------------------------- ; (beginning-of-line) ; (setq aux (point-marker)) ; (forward-char 3) ; (kill-ring-save aux (point-marker)) ; (cond ; ((and ; (string= (car kill-ring) "")) ; ((and ; (string= (car kill-ring) "(* ") ; (member (my-get-filename-suffix) *listof-sml-type-suffixes*)) ; (end-of-line) ; (move-to-column 68 t) ; (insert " *)"))) ;; -- fix done ------------------------------ (goto-char pos) (basic-save-buffer) (setq case-fold-search save-case-fold-search) (message (format "*** Updated %d occurrence(s) of %s." count pattern)) ) ) ;;; ////////////////////////////////////////////////////////////////////// ;;; [6] Templates ;;; ////////////////////////////////////////////////////////////////////// (defun get-template-file-name (&rest ask-if-not-found) "Return the name of the template file in charge, or nil if no such file is known." (let* ((ask (if ask-if-not-found (car ask-if-not-found))) (suffix (my-get-filename-suffix-respect-override)) (compare #'(lambda () (cond ((or (string= suffix "bash") nil) (scon *default-template-directory* "/bash.tpl")) ((or (string= suffix "bib") nil) (scon *default-template-directory* "/bib.tpl")) ((or (string= suffix "java") nil) (scon *default-template-directory* "/java.tpl")) ((or (string= suffix "java.override") nil) (scon *default-template-directory* "/java.override.tpl")) ((or (string= suffix "el") nil) (scon *default-template-directory* "/el.tpl")) ((or (string= suffix "tex") nil) (scon *default-template-directory* "/ttp.tpl" ;; !! changed during thesis "/tex.tpl" )) ((or (member suffix *listof-html-type-suffixes*) nil) (scon *default-template-directory* "/html.tpl")) ((or (string= suffix "bash") nil) (scon *default-template-directory* "/bash.tpl")) ((or (string= suffix "perl") nil) (scon *default-template-directory* "/perl.tpl")) ;; ------------------------------ (t nil))))) (or (funcall compare) (and ask (setq suffix (read-input "[bash bib java java.override el html tex perl]> ")) (funcall compare)) (error "** no template for that.")))) (defun insert-template-file (file) "Read the given template file and insert it in the current buffer." (let ((work (buffer-name)) (tmp nil) (pos nil) (aux nil) (beg nil) (end nil) (exec-string "")) (setq kill-ring (cons "" kill-ring)) (find-file-read-only file) (goto-char (point-min)) (setq pos (point-marker)) (goto-char (point-max)) (setq end (point-marker)) (setq tmp (buffer-name)) (while (< pos end) (set-buffer tmp) (goto-char pos) (if (search-forward *template-escape-expression-start* end t) (progn (setq aux (point-marker)) (backward-char (+ 0 (length *template-escape-expression-start*))) (kill-ring-save pos (point-marker)) (set-buffer work) ;; (goto-char (point-max)) (insert (car kill-ring)) (set-buffer tmp) (forward-char 1) (search-forward *template-escape-expression-end*) (backward-char 1) (kill-ring-save aux (point-marker)) (setq exec-string (car kill-ring)) (forward-char 1) (setq pos (point-marker)) (set-buffer work) (message (format "** Executing: \"%s\"" exec-string)) (my-execute-string exec-string) ) (progn (goto-char end) (kill-ring-save pos (point-marker)) (setq pos end) (set-buffer work) (insert (car kill-ring))))) ;; ------------------------------ (set-buffer tmp) (kill-buffer tmp) (set-buffer work) )) (defun insert-template (&rest which-template) "Insert template from a file. If an argument is given (like \"bash\"), it is expanded to the appropriate template by choosing the *default-template-directory* and adding the suffix \".tmp\"." (interactive) ;; -- Block Insertion, if (@)Version exits ------------------------------- (let ((version-string (format "%sversion" (get-escape-character))) (pos (point-marker))) (goto-char (point-min)) (setq kill-ring (cons "" kill-ring)) (if (search-forward version-string (point-max) t) (progn (goto-char pos) (error (format "** Abort - cannot insert template when \"%s\" exits." version-string))) ;; -- Insert ------------------------------------------------------- (let* ((file (if (null which-template) (get-template-file-name t) (scon *default-template-directory* "/" (car which-template) ".tpl")))) (if file (insert-template-file file) (error "** Sorry - not template defined for this file extension.") ))))) (defun insert-the-template (template-trunc) "Ask for template, then insert it" (interactive "sTemplate: ") (insert-template template-trunc)) ;;; ////////////////////////////////////////////////////////////////// ;;; [7] Computing Table of Contents (TOC) ;;; ////////////////////////////////////////////////////////////////// (defun compute-table-of-contents () "Computes a table of contents. This relies on the fact, that there are four levels of headlines: huge, big, medium, small. These are recognized (approximatively) and identified as chapter, section, subsection, subsubsection On this basis, a numeration is derived. The local variables *toc-start-(chapter|section|subsection|subsubsection)* define where to start counting. If some structure is already there (but is not reflected in the length of the headlines), then it is necessary to call toc-adjust-headlines first. If *toc-additionally-collect-lines-pattern* if non-nil, then all the text lines matching the regular expression this variables contains are incl uded in the table of contents. Relies on the existence of \"(escape-char)file\" marker." (interactive) (let ((save-case-fold-search case-fold-search)) (setq case-fold-search t) (basic-save-buffer) (let* ((current-pos (point-marker)) (res nil) (tmp nil) (tmp2 nil) (toc-pos nil) ;; -- for additional ----------------------- (text-pos nil) (next-headline nil) (next-additional nil) (next-is-headline t) (line-terminator-string (get-line-terminator-string)) (additional "") ;; ----------------------------------------- (escape-string (get-escape-character)) (start (get-file-start-line-comment)) (start-pattern (my-replace-char (aref "*" 0) "[*]" start)) (text "") (nnumbering "") (count "") (indent "") (spaces " ") (level nil) (date-string (format "[TOCD: %s]" (format-time-string "%H:%M %d %b %Y"))) (columns nil) (chapter (- *toc-start-chapter* 1)) (section (- *toc-start-section* 1)) (subsection (- *toc-start-subsection* 1)) (subsubsection (- *toc-start-subsubsection* 1)) (c2 (get-file-continuation-comment-char)) (line 61) ;; commented line length (line-terminator (get-line-terminator-lambdaexpression)) (toc-pattern (format "%sTABLE OF CONTENTS" escape-string)) (toc-end-regexp (format "^%s[ ][-#%s]" start-pattern c2)) (numbering-end-pattern "[0123456789.]+") (headline-pattern (format "^\$[ \t]*[^%s \t\n].*\\|\$\n[ \t]*%s [%s\t ]*....\n[ \t]*%s " (my-substring start-pattern 0 2) start-pattern c2 start-pattern)) (end-pattern (scon escape-string "file")) (needs-endline-fix (+ 4 (or (determine-endline-fix (my-get-filename-suffix (get-current-filename))) 0)))) ;; ------------------------------------------------------------------- (goto-char (point-min)) (if (null (and (search-forward toc-pattern (point-max) t) (search-forward-regexp toc-end-regexp (point-max) t))) (error (format "compute-table-of-contents: %s, %s not found. Abort." toc-pattern toc-end-regexp))) (next-line 1) (beginning-of-line) (setq toc-pos (point-marker)) (goto-char (point-min)) (if (search-forward toc-pattern (point-max) t) (progn ;; -- remove old table of contents ------------- (beginning-of-line) (kill-region (point-marker) toc-pos) (beginning-of-line) (setq toc-pos (point-marker)))) ;; ------------------------------------------------------------------- ;; -- collecting data ------------------------------------------------ (setq text-pos (point-marker)) ;; ---------------------------------------------- (while (progn (setq next-headline nil next-additional nil) (goto-char text-pos) (if (search-forward-regexp headline-pattern (point-max) t) (setq next-headline (point-marker))) (goto-char text-pos) (if (and *toc-additionally-collect-lines-pattern* (search-forward-regexp *toc-additionally-collect-lines-pattern* (point-max) t)) (setq next-additional (point-marker))) (or next-headline next-additional)) ;; -------------------------------------------- (setq next-is-headline t) (cond ((null next-headline) (goto-char next-additional) (setq next-is-headline nil)) ((null next-additional) (goto-char next-headline)) ((< next-headline next-additional) (goto-char next-headline)) (t ;(>= next-headline next-additional) (goto-char next-additional) (setq next-is-headline nil))) ;; -------------------------------------------- (setq tmp (point-marker)) (if next-is-headline ;; -------------------------------------------- (progn ;; -- remove old numbering, if allowed and existent ----- (end-of-line) (setq tmp2 (point-marker)) (goto-char tmp) (if (and *toc-delete-old-numbering* (search-forward *toc-numbering-start-brace* tmp2 t) (search-forward-regexp numbering-end-pattern tmp2 t) (search-forward *toc-numbering-end-brace* tmp2 t) ) (delete-region tmp (point-marker)) (goto-char tmp)) ;; -- removing: done -------------------------- (goto-next-non-whitespace) (delete-region tmp (point-marker)) (setq tmp (point-marker)) (search-forward-regexp "\$\t\\|$\$") (kill-ring-save tmp (point-marker)) (setq text (car kill-ring)) ;; -- determine level in hierarchy ------------ (previous-line 1) (end-of-line) (setq columns (current-column)) (setq level (cond ((> (+ columns (length start)) *toc-threshold-huge*) 'chapter) ((> (+ columns (length start)) *toc-threshold-big*) 'section) ((> (+ columns (length start)) *toc-threshold-medium*) 'subsection) (t 'subsubsection))) ;; -- indentation ------------------------------------------------- (setq indent (cond ((eq level 'chapter) 0) ((eq level 'section) 1) ((eq level 'subsection) 2) ((eq level 'subsubsection) 3))) ;; -- numbering --------------------------------------------------- (if (and *toc-insert-new-numbering* *toc-delete-old-numbering*) (progn ;; -- compute new numbering --------- (cond ((eq level 'chapter) (setq chapter (+ 1 chapter)) (setq count (format "%s" chapter)) (setq section (- *toc-start-section* 1)) (setq subsection (- *toc-start-subsection* 1)) (setq subsubsection (- *toc-start-subsubsection* 1))) ((eq level 'section) (setq section (+ 1 section)) (setq count (format "%s.%s" chapter section)) (setq subsection (- *toc-start-subsection* 1)) (setq subsubsection (- *toc-start-subsubsection* 1))) ((eq level 'subsection) (setq subsection (+ 1 subsection)) (setq count (format "%s.%s.%s" chapter section subsection)) (setq subsubsection (- *toc-start-subsubsection* 1))) ((eq level 'subsubsection) (setq subsubsection (+ 1 subsubsection)) (setq count (format "%s.%s.%s.%s" chapter section subsection subsubsection))) (t (error "compute-table-of-contents: unmatched case."))) (setq nnumbering (format "%s%s%s " *toc-numbering-start-brace* count *toc-numbering-end-brace*))) (setq ;; -- no numbering ---------------------------- nnumbering "")) (goto-char tmp) (insert nnumbering) (setq tmp (point-marker)) ;; -- fix closing brace --------------------------------- (cond ;; -- HTML ------------------------------------------------------- ((member (my-get-filename-suffix) *listof-html-type-suffixes*) (remove-html-comment-end) (end-of-line) (search-backward-regexp "[^ \t~]") (forward-char 1) (setq tmp2 (point-marker)) (goto-char tmp) (if (search-forward-regexp "[^ \t~]" tmp2 t) (backward-char 1)) (kill-ring-save (point-marker) tmp2) (setq text (car kill-ring)) (end-of-line) (funcall line-terminator (- columns 4)) (delete-char 1)) ;; -- SML --------------------------------------------- ((member (my-get-filename-suffix) *listof-sml-type-suffixes*) (remove-sml-comment-end) (end-of-line) (search-backward-regexp "[^ \t~]") (forward-char 1) (setq tmp2 (point-marker)) (goto-char tmp) (if (search-forward-regexp "[^ \t~]" tmp2 t) (backward-char 1)) (kill-ring-save (point-marker) tmp2) (setq text (car kill-ring)) (end-of-line) (funcall line-terminator (- columns 3)) (delete-char 1))) ;; -- compute regular table entry ----------------------- (setq res (cons (format "%s%s%s" (my-substring spaces 0 (+ 1 (* indent *toc-indent-length*))) nnumbering text) res)) (message (format "--> %s" (car res))) (forward-line 1) (setq text-pos (point-marker))) ;; --------------------------------- ;; -- else: next is an addition -------------------------------- (progn (beginning-of-line) (setq tmp (point-marker)) (if *toc-additionally-line-truncation* (move-to-column *toc-additionally-line-truncation*) (end-of-line)) (kill-ring-save tmp (point-marker)) (setq additional (car kill-ring)) ;; -------------------------------------- (setq res (cons additional res)) (message (format "ADDITION: %s" (my-replace-char (aref "%" 0) "%%" additional))) (forward-line 1) (beginning-of-line) ;; -------------------------------------- (setq text-pos (point-marker)) ))) ;; -- END OF DATA COLLECTION ----------------------------------------- ;; -- inserting table ------------------------------------------------ (goto-char toc-pos) (insert (format "%s \n" start)) (backward-char 1) (while (< (current-column) line) (insert c2)) (funcall line-terminator (+ line needs-endline-fix)) (delete-char 1) (my-loop-for-e-in-do res (previous-line 1) (insert (format "%s %s\n" start e)) (previous-line 1) (end-of-line) (funcall line-terminator (+ line needs-endline-fix)) (delete-char 1)) (previous-line 1) (insert (format "%s %sTABLE OF CONTENTS:\n" start escape-string)) (previous-line 1) (end-of-line) (move-to-column (+ (- 62 (length date-string)) (length start)) t) (insert date-string) (funcall line-terminator (+ line needs-endline-fix)) (delete-char 1) (insert (format "%s\n" start)) (previous-line 1) (end-of-line) (funcall line-terminator (+ line needs-endline-fix)) (delete-char 1) ;; -- done - restoring now ------------------------------------------- (goto-char current-pos) ) (message "** Computing Table of Contents: finished.") (setq case-fold-search save-case-fold-search))) (defun toc-take-title-from-headlines () "(used for slides only) Search for occurrences of \"\\Headline[.*]{\", then go back to the previous headline and insert the subsequent text there. Spares the very last slide. Needs compute-table-of-contents afterwards." (interactive) (if (query-approval "This will overwrite previous slide titles. Sure ") (let ((pos (point-marker)) (tmp nil) (pattern "\\Headline[[][^]]*]{") (headline-pattern (format "^%s " (get-file-start-line-comment))) (end-point (point-max))) ;; -- spare last slide -------------------------------------- (goto-char (point-max)) (if (search-backward-regexp pattern (point-min) t) (setq end-point (point-marker))) ;; ---------------------------------------------------------- (goto-char (point-min)) (while (search-forward-regexp pattern end-point t) (setq tmp (point-marker)) (end-of-line) (search-backward "}") (kill-ring-save tmp (point-marker)) (if (and (search-backward-regexp headline-pattern (point-min) t) (search-backward-regexp headline-pattern (point-min) t) (search-forward-regexp headline-pattern)) (progn (insert (car kill-ring)) (kill-region (point-marker) (point-end-of-this-line)))) (search-forward-regexp pattern end-point t) (next-line 1) ) ;; ----------------------------------------------------------------- (goto-char pos) (message "** Done with toc-take-title-from-headlines.")))) ;;; ////////////////////////////////////////////// ;;; [7.1] Jump to TOC entries ;;; ////////////////////////////////////////////// (defun highlight-point-to-end-of-line () "Highlight from point until end of this line. Re-centers. Uses text-marking to do so." (interactive) (let ((pos (point-marker))) (end-of-line) (push-mark) (exchange-point-and-mark) (goto-char pos) (recenter))) (defun highlight-line-goto-end () "Highlight this line and set position to end of it. Re-centers. Returns the previous position as a value. Uses text-marking to do so." (interactive) (let ((pos (point-marker))) (end-of-line) (push-mark) (beginning-of-line) (exchange-point-and-mark) (recenter) pos)) (defun highlight-line-goto-next-line () "Highlight this line and set position to the beginning of the next line. Re-centers. Returns the previous position as a value. Uses text-marking to do so." (interactive) (let ((pos (point-marker))) (next-line 1) (beginning-of-line) (push-mark) (previous-line 1) (beginning-of-line) (exchange-point-and-mark) (recenter) pos)) (defun jump-to-headline (numbering) "Asks for an argument, then tries to find the headline with this number. Use \"?\" to refer to any character, \"n\" to refer to any number. You can use ?*,?+,n*,n+ as in other regular expressions." (interactive "sJump to numbering: ") (let ((pos (point-marker)) (regexp (format "[[]%s[0-9.]*[]]" (my-replace-char (aref "n" 0) "[0123456789]" (my-replace-char (aref "?" 0) "." (my-replace-char (aref "." 0) "[.]" numbering)))))) (goto-char (point-min)) (if (search-forward-regexp regexp (point-max) t) ;; -- loop over input ----------------------------------- (progn (highlight-line-goto-next-line) (while (progn (setq numbering (read-string "Jump to numbering: " numbering)) (setq regexp (format "[[]%s[0-9.]*[]]" (my-replace-char (aref "n" 0) "[0123456789]" (my-replace-char (aref "?" 0) "." (my-replace-char (aref "." 0) "[.]" numbering))))) (and (search-forward-regexp regexp (point-max) t) (highlight-line-goto-next-line)))) (beep) (message (format "** No more matches for >>%s<<." numbering))) ;; -- not found ----------------------------------------- (progn (goto-char pos) (error (format "** numbering >>%s<< not found." numbering)))))) ;;; ////////////////////////////////////////////////////////////////// ;;; [8] Spell Checking ;;; ////////////////////////////////////////////////////////////////// (defun wrap-ispell () "Wraps an ispell-process. In particular, it 1. search for an (esc)ISPELL marker. If it is found, change the dictionary to the string found after it. If the value is \"default\", the current dictionary is used, and the value added in [brackets]. 2. if *spell-check-start-pattern* is non-nil and found as a regular expression, start spell checking from there. 3. if *spell-check-end-pattern* if found (forward or backward, according to *spell-check-search-end-pattern-forward-from-start*), then the spell check end here. 4. After the spell-check, if a marker is present, update the time stamp there. " (interactive) (require 'ispell) (my-clear-killring) (let ((orig-ispell-dictionary (or ispell-local-dictionary ispell-dictionary)) (pos (point-marker)) (tmp nil) (tmp2 nil) (adjust-column 40) (dictionary "/") (marker-pattern (format "%sSPELL" (get-escape-character))) (marker-was-found nil) (starts (point-min)) (ends (point-max)) ) ;; -- search for marker and change/report dictionary ------------------- ;; (basic-save-buffer) (setq kill-ring (cons "" kill-ring)) (goto-char (point-min)) (if (search-forward-regexp marker-pattern (point-max) t) (progn (goto-next-whitespace) (goto-next-non-whitespace) (setq tmp (point-marker)) (goto-next-whitespace) (kill-ring-save tmp (point-marker)) (setq dictionary (car kill-ring)) (setq tmp (point-marker)) (backward-char 1) (setq tmp2 (point-end-of-this-line)) (if (search-forward-regexp *start-of-time-or-exception-regexp* tmp2 t) (progn (message (format "now in column %d" (current-column))) (backward-word 1) (message (format "now in column %d" (current-column))) (setq adjust-column (current-column)))) (goto-char tmp) (if (string= "default" dictionary) (progn (setq dictionary orig-ispell-dictionary) (insert (format " [%s] x" dictionary))) (progn (insert " x") (ispell-change-dictionary dictionary) )) (backward-char 1) (kill-line) (message (format "adjusting to %d" adjust-column)) (move-to-column adjust-column t) (insert "UNFINISHED ") (setq marker-was-found t)) (setq dictionary orig-ispell-dictionary)) ;; -- search start and end --------------------------------------------- (goto-char (point-min)) (if (and *spell-check-start-pattern* (search-forward-regexp *spell-check-start-pattern* (point-max) t)) (setq starts (point-marker))) (if (and *spell-check-end-pattern* (if *spell-check-search-end-pattern-forward-from-start* (search-forward-regexp *spell-check-end-pattern* (point-max) t) (progn (goto-char (point-max)) (search-backward-regexp *spell-check-end-pattern* (point-min) t)))) (setq ends (point-marker))) ;; --------------------------------------------------------------------- (if (ispell-region starts ends) nil (error "Ispell was aborted.")) ;; -- (possibly) insert time stamp ------------------------------------- (if marker-was-found (progn (goto-char (point-min)) (search-forward-regexp marker-pattern) (end-of-line) (move-to-column adjust-column t) (kill-line) (insert (current-time-string)) (funcall (get-line-terminator-lambdaexpression)) (delete-char 1))) (goto-char pos) (ispell-change-dictionary orig-ispell-dictionary) (message (format "** wrap-ispell [%s] finished %s" dictionary (if marker-was-found "and time stamp updated" ""))) )) ;;; ------------------------------------------------------------------ ;;; ////////////////////////////////////////////// ;;; [8.1] Shared Documents: (a)LAST ;;; ////////////////////////////////////////////// (defun update-last-user-if-mark-present () "Searches for LAST and inserts current user" (interactive) (let ((pos (point-marker)) (pattern (format "%sLAST" (get-escape-character))) (line-terminator (get-line-terminator-lambdaexpression))) (goto-char (point-min)) (if (search-forward pattern (point-max) t) (progn (search-forward-regexp "[ \t]") (search-forward-regexp "[^ ]") (backward-char 1) (kill-line 1) (insert (format "%s\n" (getenv "USER"))) (backward-char 1) (funcall line-terminator 60) (backward-delete-char 1))) (goto-char pos))) ;;; ////////////////////////////////////////////////////////////////// ;;; [9] Activating key-bindings ;;; ////////////////////////////////////////////////////////////////// ;;; ////////////////////////////////////////////// ;;; [9.1] Macro Definitions ;;; ////////////////////////////////////////////// (fset 'better-copy-last-line [?x backspace ?\M-x ?c ?o ?p ?y ?- ?l ?a ?s ?t ?- ?l ?i ?n ?e return]) (fset 'better-copy-this-line [?x backspace ?\M-x ?c ?o ?p ?y ?- ?t ?h ?i ?s ?- ?l ?i ?n ?e return]) (fset 'better-copy-last-complex-statement [?x backspace ?\M-x ?c ?o ?p ?y ?- ?l ?a ?s ?t ?- ?c ?o ?m ?p ?l ?e ?x ?- ?s ?t ?a ?t ?e ?m ?e ?n ?t return ]) (fset 'better-text-insert-huge-headline [?x backspace ?\M-x ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?h ?u ?g ?e ?- ?h ?e ?a ?d ?l ?i ?n ?e return]) (fset 'better-text-insert-big-headline [?x backspace ?\M-x ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?b ?i ?g ?- ?h ?e ?a ?d ?l ?i ?n ?e return]) (fset 'better-text-insert-medium-headline [?x backspace ?\M-x ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?m ?e ?d ?i ?u ?m ?- ?h ?e ?a ?d ?l ?i ?n ?e return]) (fset 'better-text-insert-small-headline [?x backspace ?\M-x ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?s ?m ?a ?l ?l ?- ?h ?e ?a ?d ?l ?i ?n ?e return]) (fset 'better-text-insert-huge-semaphore [?x backspace ?\M-x ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?h ?u ?g ?e ?- ?s ?e ?m ?a ?p ?h ?o ?r ?e return]) (fset 'better-text-insert-big-semaphore [?x backspace ?\M-x ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?b ?i ?g ?- ?s ?e ?m ?a ?p ?h ?o ?r ?e return]) (fset 'better-text-insert-medium-semaphore [?x backspace ?\M-x ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?m ?e ?d ?i ?u ?m ?- ?s ?e ?m ?a ?p ?h ?o ?r ?e return]) (fset 'better-text-insert-huge-end-line-comment [?x backspace ?\M-x ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?h ?u ?g ?e ?- ?e ?n ?d ?- ?l ?i ?n ?e ?- ?c ?o ?m ?m ?e ?n ?t return]) (fset 'better-text-insert-big-end-line-comment [?x backspace ?\M-x ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?b ?i ?g ?- ?e ?n ?d ?- ?l ?i ?n ?e ?- ?c ?o ?m ?m ?e ?n ?t return]) (fset 'better-text-insert-medium-end-line-comment [?x backspace ?\M-x ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?m ?e ?d ?i ?u ?m ?- ?e ?n ?d ?- ?l ?i ?n ?e ?- ?c ?o ?m ?m ?e ?n ?t return]) (fset 'better-insert-disclaimer [?x backspace ?\M-x ?i ?n ?s ?e ?r ?t ?- ?d ?i ?s ?c ?l ?a ?i ?m ?e ?r return]) (fset 'better-insert-template (read-kbd-macro "x DEL M-x insert- template RET")) (fset 'better-compute-table-of-contents (read-kbd-macro "x DEL M-x compute- table- of- contents RET") ) ;; -- DOES NOT WORK: RINGS BELL -------------------------------------------- (fset 'better-wrap-ispell (read-kbd-macro "x DEL M-x wrap-ispell RET")) ;;; ////////////////////////////////////////////// ;;; [9.2] Binding ;;; ////////////////////////////////////////////// (fset 'tocedit-init [ ?\M-x ?g ?l ?o ?b ?a ?l ?- ?s ?e ?t ?- ?k ?e ?y ?\r ?\C-c ?\C-1 ?b ?e ?t ?t ?e ?r ?- ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?h ?u ?g ?e ?- ?h ?e ?a ?d ?l ?i ?n ?e ?\r ?\M-x ?g ?l ?o ?b ?a ?l ?- ?s ?e ?t ?- ?k ?e ?y ?\r ?\C-c ?\C-2 ?b ?e ?t ?t ?e ?r ?- ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?b ?i ?g ?- ?h ?e ?a ?d ?l ?i ?n ?e ?\r ?\M-x ?g ?l ?o ?b ?a ?l ?- ?s ?e ?t ?- ?k ?e ?y ?\r ?\C-c ?\C-3 ?b ?e ?t ?t ?e ?r ?- ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?m ?e ?d ?i ?u ?m ?- ?h ?e ?a ?d ?l ?i ?n ?e ?\r ?\M-x ?g ?l ?o ?b ?a ?l ?- ?s ?e ?t ?- ?k ?e ?y ?\r ?\C-c ?\C-4 ?b ?e ?t ?t ?e ?r ?- ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?s ?m ?a ?l ?l ?- ?h ?e ?a ?d ?l ?i ?n ?e ?\r ?\M-x ?g ?l ?o ?b ?a ?l ?- ?s ?e ?t ?- ?k ?e ?y ?\r ?\C-c ?\C-0 ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?h ?e ?a ?d ?l ?i ?n ?e ?\r ;; -- semaphore --------------------------------------- ?\M-x ?g ?l ?o ?b ?a ?l ?- ?s ?e ?t ?- ?k ?e ?y ?\r ?\C-c ?\C-5 ?b ?e ?t ?t ?e ?r ?- ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?h ?u ?g ?e ?- ?s ?e ?m ?a ?p ?h ?o ?r ?e ?\r ?\M-x ?g ?l ?o ?b ?a ?l ?- ?s ?e ?t ?- ?k ?e ?y ?\r ?\C-c ?\C-6 ?b ?e ?t ?t ?e ?r ?- ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?b ?i ?g ?- ?s ?e ?m ?a ?p ?h ?o ?r ?e ?\r ?\M-x ?g ?l ?o ?b ?a ?l ?- ?s ?e ?t ?- ?k ?e ?y ?\r ?\C-c ?\C-7 ?b ?e ?t ?t ?e ?r ?- ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?m ?e ?d ?i ?u ?m ?- ?s ?e ?m ?a ?p ?h ?o ?r ?e ?\r ?\M-x ?g ?l ?o ?b ?a ?l ?- ?s ?e ?t ?- ?k ?e ?y ?\r ?\C-c ?\C-9 ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?s ?e ?m ?a ?p ?h ?o ?r ?e ?\r ;; -- end-line-comment -------------------------------- ?\M-x ?g ?l ?o ?b ?a ?l ?- ?s ?e ?t ?- ?k ?e ?y ?\r ?\C-c ?5 ?b ?e ?t ?t ?e ?r ?- ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?h ?u ?g ?e ?- ?e ?n ?d ?- ?l ?i ?n ?e ?- ?c ?o ?m ?m ?e ?n ?t ?\r ?\M-x ?g ?l ?o ?b ?a ?l ?- ?s ?e ?t ?- ?k ?e ?y ?\r ?\C-c ?6 ?b ?e ?t ?t ?e ?r ?- ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?b ?i ?g ?- ?e ?n ?d ?- ?l ?i ?n ?e ?- ?c ?o ?m ?m ?e ?n ?t ?\r ?\M-x ?g ?l ?o ?b ?a ?l ?- ?s ?e ?t ?- ?k ?e ?y ?\r ?\C-c ?7 ?b ?e ?t ?t ?e ?r ?- ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?m ?e ?d ?i ?u ?m ?- ?e ?n ?d ?- ?l ?i ?n ?e ?- ?c ?o ?m ?m ?e ?n ?t ?\r ?\M-x ?g ?l ?o ?b ?a ?l ?- ?s ?e ?t ?- ?k ?e ?y ?\r ?\C-c ?9 ?t ?e ?x ?t ?- ?i ?n ?s ?e ?r ?t ?- ?e ?n ?d ?- ?l ?i ?n ?e ?- ?c ?o ?m ?m ?e ?n ?t ?\r ;; -- DISCLAIMER ----------------------------------------------------------- ?\M-x ?g ?l ?o ?b ?a ?l ?- ?s ?e ?t ?- ?k ?e ?y ?\r ?\C-c ?. ?b ?e ?t ?t ?e ?r ?- ?i ?n ?s ?e ?r ?t ?- ?d ?i ?s ?c ?l ?a ?i ?m ?e ?r ?\r ;; -- TABLE OF CONTENTS ---------------------------------------------------- ?\M-x ?g ?l ?o ?b ?a ?l ?- ?s ?e ?t ?- ?k ?e ?y ?\r ?\C-c ?= ?b ?e ?t ?t ?e ?r ?- ?c ?o ?m ?p ?u ?t ?e ?- ?t ?a ?b ?l ?e ?- ?o ?f ?- ?c ?o ?n ?t ?e ?n ?t ?s ?\r ;; -- JUMP-TO-HEADLINE ----------------------------------------------------- ?\M-x ?g ?l ?o ?b ?a ?l ?- ?s ?e ?t ?- ?k ?e ?y ?\r ?\C-c ?/ ?j ?u ?m ?p ?- ?t ?o ?- ?h ?e ?a ?d ?l ?i ?n ?e ?\r ;; -- WRAP ISPELL ---------------------------------------------------------- ?\M-x ?g ?l ?o ?b ?a ?l ?- ?s ?e ?t ?- ?k ?e ?y ?\r ?\C-c ?i ?w ?r ?a ?p ?- ?i ?s ?p ?e ?l ?l ?\r ]) ;; -- HEADLINES ------------------------------------------------------------ ;;; C-c C-1 better-text-insert-huge-headline ;;; C-c C-2 better-text-insert-big-headline ;;; C-c C-3 better-text-insert-medium-headline ;;; C-c C-4 better-text-insert-small-headline ;;; C-c C-0 text-insert-headline ;;; C-c C-5 better-text-insert-huge-semaphore ;;; C-c C-6 better-text-insert-big-semaphore ;;; C-c C-7 better-text-insert-medium-semaphore ;;; C-c C-9 text-insert-semaphore ;;; C-c 5 better-text-insert-huge-end-line-comment ;;; C-c 6 better-text-insert-big-end-line-comment ;;; C-c 7 better-text-insert-medium-end-line-comment ;;; C-c 9 text-insert-end-line-comment ;; -- OTHER ---------------------------------------------------------------- ;;; C-c . better-insert-disclaimer ;;; C-c = better-compute-table-of-contents ;;; C-c / jump-to-headline ;;; C-c i wrap-ispell ;; ------------------------------------------------------------------------- (provide 'tocedit)