;;; tipmode.el --- A mode for editing Tcl Improvement Proposals. ;; Copyright (C) 2000 Donal K. Fellows (defconst tip-mode-revision-string "$Id: tipmode.el,v 1.13 2004/08/09 22:15:14 dkf Exp $" "Some CVS/RCS info relating to tipmode.el...") ;(require 'text) ; text-mode always available? (defgroup tip nil "Major mode for editing Tcl Improvement Proposals." :group 'tcl :group 'text :prefix "tip-") (defgroup tipface nil "Faces used when highlighting TIPs." :group 'tip :group 'faces) (defcustom tip-mode-hook nil "Normal hook run when entering TIP mode." :type 'hook :group 'tip) (defcustom tip-skeleton-head "TIP: ??? Title: Title for Skeleton TIP State: Draft Type: Project Tcl-Version: 9.0 Vote: Pending Post-History: " "*A skeleton of a TIP header, minus certain derivable/computed fields." :type 'string :group 'tip) (defcustom tip-skeleton-body "~ Abstract A ''single'' paragraph, in third person voice, outlining what your TIP is all about. ~ Rationale Why is this TIP needed? ~ Proposed Change What are you going to do? ''This need not include a patch during initial discussion, and should not include a verbatim patch at all (due to publishing restrictions.)'' ~ Copyright This document has been placed in the public domain. " "*A skeleton of a TIP body, a suitable place to start writing your own." :type 'string :group 'tip) (defvar tip-header-key-face 'tip-header-key-face "Face name to use for keys in TIP headers.") (defvar tip-header-value-face 'tip-header-value-face "Face name to use for values in TIP headers.") (defvar tip-verbatim-face 'tip-verbatim-face "Face name to use for verbatim text in TIPs.") (defvar tip-magic-paragraph-start-face 'tip-magic-paragraph-start-face "Face name to use for symbol sequences that start specially meaningful paragraphs in TIPs.") (defvar tip-section-title-face 'tip-section-title-face "Face name to use for section titles in TIPs.") (defvar tip-magic-paragraph-info-face 'tip-magic-paragraph-info-face "Face name to use for extra info that follow paragraph starts with special meaning in TIPs.") (defvar tip-list-start-face 'tip-list-start-face "Face name to use for list item start sequences in TIPs.") (defvar tip-uri-face 'tip-uri-face "Face name to use for URIs in TIPs.") (defface tip-header-key-face ;copy of font-lock-builtin-face '((((class grayscale) (background light)) (:foreground "LightGray" :bold t)) (((class grayscale) (background dark)) (:foreground "DimGray" :bold t)) (((class color) (background light)) (:foreground "Purple")) (((class color) (background dark)) (:foreground "Cyan")) (t (:bold t))) "Face for highlighting keys in TIP headers." :group 'tipface) (defface tip-header-value-face ;copy of font-lock-function-name-face '((((class color) (background light)) (:foreground "Blue")) (((class color) (background dark)) (:foreground "LightSkyBlue")) (t (:inverse-video t :bold t))) "Face for highlighting values in TIP headers." :group 'tipface) (defface tip-verbatim-face ;copy of font-lock-string-face '((((class grayscale) (background light)) (:foreground "DimGray" :italic t)) (((class grayscale) (background dark)) (:foreground "LightGray" :italic t)) (((class color) (background light)) (:foreground "RosyBrown")) (((class color) (background dark)) (:foreground "LightSalmon")) (t (:italic t))) "Face for highlighting verbatim paragraphs in TIPs." :group 'tipface) (defface tip-magic-paragraph-start-face ;copy of font-lock-function-name-face '((((class color) (background light)) (:foreground "Blue")) (((class color) (background dark)) (:foreground "LightSkyBlue")) (t (:inverse-video t :bold t))) "Face for highlighting symbol sequences that start specially meaningful paragraphs in TIPs." :group 'tipface) (defface tip-magic-paragraph-info-face ;copy of font-lock-variable-name-face '((((class grayscale) (background light)) (:foreground "Gray90" :bold t :italic t)) (((class grayscale) (background dark)) (:foreground "DimGray" :bold t :italic t)) (((class color) (background light)) (:foreground "DarkGoldenrod")) (((class color) (background dark)) (:foreground "LightGoldenrod")) (t (:bold t :italic t))) "Face for highlighting extra info that follow paragraph starts with special meaning in TIPs." :group 'tipface) (defface tip-section-title-face ;copy of font-lock-constant-face '((((class grayscale) (background light)) (:foreground "LightGray" :bold t :underline t)) (((class grayscale) (background dark)) (:foreground "Gray50" :bold t :underline t)) (((class color) (background light)) (:foreground "CadetBlue")) (((class color) (background dark)) (:foreground "Aquamarine")) (t (:bold t :underline t))) "Face for highlighting section titles in TIPs." :group 'tipface) (defface tip-list-start-face ;copy of font-lock-function-name-face '((((class color) (background light)) (:foreground "Blue")) (((class color) (background dark)) (:foreground "LightSkyBlue")) (t (:inverse-video t :bold t))) "Face for highlighting list item start sequences in TIPs." :group 'tipface) (defface tip-uri-face '((t (:underline t))) "Face for highlighting URIs in TIPs." :group 'tipface) (defvar tip-mode-syntax-table (make-syntax-table text-mode-syntax-table) "Syntax table used while in TIP mode.") (defvar tip-mode-abbrev-table nil "Abbrev table used while in TIP mode.") (define-abbrev-table 'tip-mode-abbrev-table ()) (defvar tip-mode-map () "Keymap for TIP mode.") (if tip-mode-map () (setq tip-mode-map (copy-keymap text-mode-map)) (let ((map (make-sparse-keymap))) (define-key map "s" 'tip-insert-section-header) (define-key map "i" 'tip-insert-image) (define-key map "x" 'tip-insert-index) (define-key map "v" 'tip-verbatim-region) (define-key map "\C-c" 'tip-insert-skeleton) (define-key map "p" 'tip-check-spelling) (define-key map "h" 'tip-verify-headers) (define-key tip-mode-map "\C-c" map) (define-key tip-mode-map [menu-bar] (make-sparse-keymap)) (define-key tip-mode-map [menu-bar tip] (cons "TIP" (make-sparse-keymap "TIP"))) (define-key tip-mode-map [menu-bar tip verbatim-region] '("Verbatim Region" . tip-verbatim-region)) (define-key tip-mode-map [menu-bar tip insert-image] '("Insert Image" . tip-insert-image)) (define-key tip-mode-map [menu-bar tip insert-index] '("Insert Index" . tip-insert-index)) (define-key tip-mode-map [menu-bar tip insert-section-header] '("Insert Section" . tip-insert-section-header)) (define-key tip-mode-map [menu-bar tip check-spelling] '("Check Spelling" . tip-check-spelling)) (define-key tip-mode-map [menu-bar tip verify-headers] '("Verify Headers" . tip-verify-headers)) (define-key tip-mode-map [menu-bar tip insert-skeleton] '("Insert Skeleton" . tip-insert-skeleton)) (put 'tip-verbatim-region 'menu-enable 'mark-active) )) (defvar tip-font-lock-keywords '(("^\\(#i\\(ndex\\|mage\\):\\)\\(\\S-*\\)" (1 tip-magic-paragraph-start-face) (3 tip-magic-paragraph-info-face)) ("^\\(~\\)\\s-*\\(\\S-.*\\)" (1 tip-magic-paragraph-start-face) (2 tip-section-title-face)) ("^\\(\\(T\\(IP\\|itle\\|ype\\)\\|\\(Tcl-\\)?Version\\|Author\\|State\\|Vote\\(-By\\|s-\\(For\\|A\\(gainst\\|bstained\\)\\)\\)?\\|Created\\|Post-History\\|Obsolete\\(s\\|d-By\\)\\|Keywords\\|Discussions-To\\):\\)[ \t]*\\(\\(\\S-.*\\)?\\)" (1 tip-header-key-face) (6 tip-header-value-face)) ("^|.*" (0 tip-verbatim-face)) ("^[ \t]+\\(\\(>\\s-+\\)*\\([*>]\\|[0-9]+.\\|.*:\\)\\)" (1 tip-list-start-face)) ("\\(https?\\|ftp\\|news\\|newsrc\\|mailto\\|gopher\\):\\([-a-zA-Z0-9.]+:[0-9]+/\\)?[-A-Za-z0-9/_.%#+@?=&;~]+" (0 tip-uri-face)) ("tip:[0-9]+" (0 tip-uri-face)) ("<\\(\\S-+@\\S-+\\)>" (1 tip-uri-face))) "Default expressions to highlight in TIP mode.") (defvar tip-font-lock-defaults '(tip-font-lock-keywords t nil nil mark-paragraph)) (defvar tip-imenu-generic-expression '((nil "^~\\s-*\\(.*\\)" 1))) ;;;###autoload (defun tip-mode () "Major mode for editing TIP documents. The following keys are bound: \\{tip-mode-map} " (interactive) (text-mode) (set-syntax-table tip-mode-syntax-table) (use-local-map tip-mode-map) (make-local-variable 'imenu-generic-expression) (make-local-variable 'font-lock-defaults) (setq major-mode 'tip-mode mode-name "TIP" local-abbrev-table tip-mode-abbrev-table imenu-generic-expression tip-imenu-generic-expression font-lock-defaults tip-font-lock-defaults ) (imenu-add-to-menubar "Sections") (run-hooks 'tip-mode-hook) ) (defun tip-insert-paragraph (string) (or (bolp) (insert "\n")) (insert "\n" string "\n") (or (eolp) (insert "\n"))) (defun tip-insert-section-header (title) "Insert a section header paragraph." (interactive "*MSection title:") (tip-insert-paragraph (format "~ %s" title))) (defun tip-insert-index (kind) "Insert an index paragraph." (interactive (list (completing-read "Index kind: " [short medium long] nil t nil nil "medium"))) (tip-insert-paragraph (format "#index:%s" kind))) (defun tip-insert-image (url caption) "Insert an image paragraph." (interactive "*sURL to reference: \nMCaption for image: ") (tip-insert-paragraph (format "#image:%s %s" url caption))) (defun tip-verbatim-region (from to) "Makes the lines including the region into verbatim text." (interactive "*r") (let (fm tm) (goto-char from) (beginning-of-line) (setq fm (point-marker)) (goto-char to) (or (bolp) (end-of-line)) (setq tm (point-marker)) (untabify fm tm) (goto-char fm) (while (< (point) tm) (beginning-of-line) (insert "|") (forward-line)) (set-marker fm nil) (set-marker tm nil))) (defun tip-insert-skeleton () "Insert a skeleton TIP into the current buffer. This allows people to get started writing a TIP much more rapidly." (interactive) (insert tip-skeleton-head) (insert (format "%cVersion:%c%cRevision%c" 10 9 36 36)) (insert (format "%cAuthor:%c%c%s <%s>" 10 9 9 (user-full-name) user-mail-address)) (insert (format-time-string "%nCreated:%t%d-%b-%Y")) (insert (format "%c%c" 10 10)) (insert tip-skeleton-body)) ;; Copied and adapted shamelessly from ispell.el! (defun tip-check-spelling () (interactive) (save-excursion (goto-char (point-min)) (let* ((end-of-headers ; Start of body. (copy-marker (or (re-search-forward "^$" nil t) (point-min)))) (limit (copy-marker ; End of region we will spell check. (cond ((not ispell-message-text-end) (point-max)) ((char-or-string-p ispell-message-text-end) (if (re-search-forward ispell-message-text-end nil t) (match-beginning 0) (point-max))) (t (min (point-max) (funcall ispell-message-text-end)))))) (ispell-skip-region-alist (cons (list "^|" (function forward-line)) ispell-skip-region-alist)) (old-case-fold-search case-fold-search) (case-fold-search t) (dictionary-alist ispell-message-dictionary-alist) (ispell-checking-message t)) (or (local-variable-p 'ispell-local-dictionary (current-buffer)) (while dictionary-alist (goto-char (point-min)) (if (re-search-forward (car (car dictionary-alist)) end-of-headers t) (setq ispell-local-dictionary (cdr (car dictionary-alist)) dictionary-alist nil) (setq dictionary-alist (cdr dictionary-alist))))) (unwind-protect (progn ;; Spell check any Title: or Keywords: (goto-char (point-min)) (while (re-search-forward "^\\(Title\\|Keywords\\): *" end-of-headers t) (progn (goto-char (match-end 0)) (let ((case-fold-search old-case-fold-search)) (ispell-region (point) (progn ;Tab-initiated continuation lns. (end-of-line) (while (looking-at "\n[ \t]") (end-of-line 2)) (point)))))) (goto-char end-of-headers) (forward-line 1) (ispell-region (point) limit)) (set-marker end-of-headers nil) (set-marker limit nil))))) (defconst tip-verify-states-re "^\\(Draft\\|Accepted\\|Deferred\\|Final\\|Active\\|Rejected\\|Withdrawn\\)$" "Regexp matching the acceptable values for the State: header field.") (defconst tip-verify-types-re "^\\(Project\\|Process\\|Inform.*\\)$" "Regexp matching the acceptable values for the Type: header field.") (defconst tip-verify-tclver-re "^[0-9]+\\.[0-9]+\\([.ab][0-9]+\\)?$" "Regexp matching the acceptable values for the Tcl-Version: header field.") (defconst tip-verify-vote-re "^\\(Pending\\|In progress\\|Done\\|No voting\\)$" "Regexp matching the acceptable values for the Vote: header field.") (defconst tip-verify-created-re "^[0-9][0-9]-\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)-20[0-9][0-9]$" "Regexp matching the acceptable values for the Created: header field.") (defconst tip-verify-author-re "^.+ <.+@.+>$" "Regexp matching the acceptable values for the Author: header field.") (defconst tip-header-matcher-alist (list '("TIP" . "^[0-9]+$") '("Title" . ".") '("Version" . "^\$.+\$$") (cons "State" tip-verify-states-re) (cons "Type" tip-verify-types-re) (cons "Tcl-Version" tip-verify-tclver-re) (cons "Vote" tip-verify-vote-re) (cons "Created" tip-verify-created-re) (cons "Author" tip-verify-author-re) '("Obsoletes" . "^[0-9]_$") '("Obsoleted-By" . "^[0-9]_$") '("Post-History" . ".*") '("Discussions-To" . ".+") '("Keywords" . ".+") '("Vote-By" . ".+") '("Votes-For" . ".+") '("Votes-Against" . ".+") '("Votes-Abstained" . ".+")) "Alist of matchers for each of the legal TIP headers.") (defun tip-verify-headers () "Perform a basic verification check on the TIP headers." (interactive) (save-excursion (goto-char (point-min)) (let ((headers) (end-of-headers ; Start of body. (copy-marker (or (re-search-forward "^$" nil t) (point-min))))) (goto-char (point-min)) (while (re-search-forward "^\\([-a-zA-Z]+\\):[ \t]*\\(.*\\)" end-of-headers t) (let* ((key (match-string 1)) (body (match-string 2)) (next (match-end 0)) (re (assoc key tip-header-matcher-alist))) (cond ((not re) (error "Unknown header '%s:'" key)) ((string-match (cdr re) body) (setq headers (cons (cons key body) headers))) (t (error "Illegal header '%s: %s'" key body))) (goto-char next))) (or (assoc "TIP" headers) (error "Missing header 'TIP:'")) (or (assoc "Title" headers) (error "Missing header 'Title:'")) (or (assoc "Version" headers) (error "Missing header 'Version:'")) (or (assoc "State" headers) (error "Missing header 'State:'")) (or (assoc "Type" headers) (error "Missing header 'Type:'")) (or (assoc "Vote" headers) (error "Missing header 'Vote:'")) (or (assoc "Created" headers) (error "Missing header 'Created:'")) (or (assoc "Author" headers) (error "Missing header 'Author:'")) (or (assoc "Post-History" headers) (error "Missing header 'Post-History:'")) (let ((project (equal "Project" (cdr (assoc "Type" headers)))) (tcl-version (assoc "Tcl-Version" headers))) (if (and (not project) tcl-version) (error "Can only have 'Tcl-Version:' header in Project TIPs")) (if (and project (not tcl-version)) (error "Must have 'Tcl-Version:' header in Project TIPs"))) (message "TIP headers seem OK")))) ;; Arrange for the mode to become associated with all buffers whose ;; filenames end in .tip, unless this has been done already... (if (assoc "\\.tip\\'" auto-mode-alist) () (setq auto-mode-alist (cons '("\\.tip\\'" . tip-mode) auto-mode-alist))) (message "%s" tip-mode-revision-string) (provide 'tipmode) ;; $Log: tipmode.el,v $ ;; Revision 1.13 2004/08/09 22:15:14 dkf ;; Extend support for the new headers to the Emacs support ;; ;; Revision 1.12 2003/08/15 08:11:46 dkf ;; Omitted the Deferred state from the State: header checking RE. D'oh! ;; ;; Revision 1.11 2002/02/20 09:21:06 dkf ;; URLs can contain '%' so add it to match set. ;; ;; Revision 1.10 2002/01/10 11:57:11 dkf ;; Now have correctly functioning TIP header verifier. ;; ;; Revision 1.9 2001/12/18 14:12:14 dkf ;; More advanced online searching and some verification ability in the emacs mode ;; ;; Revision 1.8 2001/09/04 09:34:03 dkf ;; Substantive enhancement to tipmode.el (spelling+menu) ;; ;; Revision 1.7 2001/03/09 14:26:51 dkf ;; Supported https URLs and added a skeleton TIP generation function. ;; ;; Revision 1.6 2000/12/01 10:56:50 dkf ;; Improved autoloading. ;; ;; Revision 1.5 2000/11/21 15:25:29 dkf ;; Added a batch of "useful" editing commands. ;; ;; Revision 1.4 2000/11/21 10:25:54 dkf ;; Improved highlight regexps. ;; ;; Revision 1.3 2000/11/17 15:11:16 dkf ;; Improved support for other people's use and removed a stupid ;; font-definition bug. ;; ;; Revision 1.2 2000/11/15 14:17:07 dkf ;; Bugfixes... ;; ;; Revision 1.1 2000/11/15 11:49:51 dkf ;; Tweaked the LaTeX generator to remind people to get the accompanying ;; images, and added an emacs mode for editing TIPs. ;;